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A  Numerical  Model  for  the  Computation  of  Radiance  Distributions 
in  Natural  Waters  with  Wind-Roughened  Surfaces,  Part  II: 
Users’  Guide  and  Code  Listing 

Curtis  D.  Mobley* 


ABSTRACT.  This  report  is  a  users’  guide  for  and  listing  of  the  FORTRAN  V  computer  code  that 
implements  a  numerical  procedure  for  computing  radiance  distributions  in  natural  waters.  The 
mathematical  details  of  the  numerical  radiance  model  are  described  in  a  companion  report  (A 
Numerical  Model  for  the  Computation  of  Radiance  Distributions  in  Natural  Waters  with  Wind- 
Roughened  Surfaces,  by  Curtis  D.  Mobley  and  Rudolph  W.  Preisendorfer,  NOAA  Technical 
Memorandum  ERL  PMEL-75).  The  present  report  describes  how  to  run  the  computer  model  and 
therefore  addresses  questions  such  as  which  routines  perform  which  calculations,  what  input  is 
required  by  the  various  programs,  and  what  is  the  file  structure  of  the  overall  program. 


1,  INTRODUCTION 

General  knowledge  of  the  radiance  distribution  in  a  natural  hydiosol,  such  as  a  lake  or 
ocean,  is  a  prerequisite  for  the  solution  of  more  specific  problems  in  underwater  visibility, 
remote  sensing,  photosynthesis,  or  climatology.  Moreover,  since  radiance  is  the  fundamental 
radiometric  quantity,  if  the  radiance  distribution  is  known,  then  all  other  quantities  of  interest, 
such  as  the  irradiances  and  K-functions,  are  easily  computed. 

With  the  above  incentivc.s,  a  numerical  model,  called  the  Natural  Hydrosol  Model  or  NHM, 
was  developed,  based  on  the  following  assumptions: 

(1)  7’he  water  body  is  a  plane-parallel  medium  which 

(a)  has  no  internal  light  sources,  and  is  non-fluorescent 

(b)  is  directionally  isotropic, 

(c)  is  laterally  homogeneous,  but  is  inhomogeneous  with  depth. 

(2)  I'he  upper  boundary  is  the  random  air-water  interface,  which  is  wind-ruffled, 
laterally  homogeneous,  and  azimuthally  anisotropic. 

(3)  The  lower  boundary  is  a  surface  whose  reflectance  is  azimuthally  isotropic.  This 
bound;!ry  may  be  ether  the  physical  bottom  of  an  optically  shallow  water  body,  or  a 
plane  in  an  op^  eally  infinitely  deep  water  body,  below  which  the  water  is 
homogeneous  with  depth. 

(4)  There  is  radiant  flux  incident  downward  on  the  upper  boundary.  There  is  no  radiant 
flux  incident  upward  on  the  lower  boundary. 
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(5)  The  radiance  field  is  monochromatic  and  unpolarized. 

The  exact  meaning  of  these  assumptions  and  their  mathematical  consequences  are  de¬ 
scribed  in  the  following  two  reports 

(1)  "The  NHM  report."  This  technical  memorandum  is  the  companion  to  the  present  one, 
and  should  be  studied  prior  to  reading  this  report.  The  NHM  report  describes  the  overall  com¬ 
putational  staicture  of  the  Natural  Hydrosol  Model  and  contains  all  the  mathematical  details. 
The  full  reference  is 

A  Numerical  Model  for  the  Computation  of  Radiance  Distributions  in  Natural 
Waters  with  Wind-Roughened  Surfaces,  by  Curtis  D.  Mobley  and  Rudolph  W. 
Preisendorfer,  NOAA  Tech.  Memo.  liRL  PMEL-75,  Pacific  Marine  Environmental 
Laboratory,  Seattle,  WA  9S1 15,  January  1988,  195  pages.  (Also  available  from  the 
National  Technical  Information  Service,  5285  Port  Royal  Road,  Sprinfield  VA 
22161,  as  report  number  PB88- 192703.) 

(2)  "The  ray-tracing  report."  This  technical  memorandum  describes  mathematical  algo¬ 
rithms  for  simulating  random  ;.;r-water  surfaces  and  for  tracing  light  rays  as  the  rays  interact  with 
the  simulated  water  surface,  rius  ray-tracing  procedure  is  used  in  computing  the  surface  bound¬ 
ary  conditions  for  the  md’anc^  computations  (cf.  assumption  2,  above).  The  full  reference  is 

Unpolarized  Irradlance  Reflectances  and  Glitter  Patterns  of  Random  Capillary 
Waves  on  Lakes  and  Seas,  by  Monte  Carlo  Simulation,  by  Rudolph  W.  Preisen¬ 
dorfer  and  Curtis  D.  Mobley,  NOAA  Tech.  Memo.  ERL  PMEL-63,  Pacific  Marine 
Environmental  Laboratm-N’.  Seattle,  WA  98115,  Sept.  1985,  141  pages.  (Available 
from  NTIS  as  report  number  PB86- 123577.) 

Comments  throughout  the  computer  code  and  in  the  de.scriptive  sections  of  this  report 
make  frequent  reference  to  tlie  NH.M  report  (reference  I,  just  cited),  enabling  the  user  of  the  code 
to  trace  in  detail  the  implementation  of  the  mathematical  procedures.  Thus,  in  the  computer 
code,  the  comment  "compute  forw-ard  .scattering  by  11.7"  refers  to  equation  11.7  in  report 
ERL  PMEL-75.  Comments  refering  to  the  ray-tracing  report,  ERL  PMEL-63,  are  prefaced  by 
"63/  ".  Thus  a  reference  to  "63/3.20 "  refers  to  equation  3.20  in  the  ray-tracing  report.  To  avoid 
confusion  in  the  pre.seni  repon,  references  to  the  NHM  repon,  ERL  PMEL-75,  are  prefaced  by 
"7.V 

The  various  computations  perfomied  by  the  NHM  are  grouped  into  five  separate  programs, 
which  are  run  in  .icquence  t  ,  obtain  the  solution  of  a  given  problem.  The  first  three  programs 
compute  the  surface  bouno,  ry  reflectance  and  transmittance  functions.  The  founh  program 
solves  for  the  radiance  amj'iitudes  at  all  depths,  and  the  fifth  program  then  reconstitutes  the 
radiances  and  analyzes  the  results.  A  sixth  set  of  programs  for  graphical  analysis  of  the  numeri¬ 
cal  results  is  included  for  convenience  although,  strictly  speaking,  these  programs  are  not  a  part 
of  the  NHM. 

The  following  six  sections  of  this  report  describe  in  turn  the  NHM  programs.  Each  section 
begins  with  a  brief  description  of  the  program.  Then  there  are  sections  on  the  user-supplied  input 
recjuired  to  run  the  program,  and  on  file  management.  Each  program  consists  of  a  main  program 
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named  MAIN,  which  controls  overall  program  flow,  and  a  subroutine  named  INISHL,  which 
reads  the  user-supplied  data  and  performs  other  initialization  tasks.  The  reader  wishing  to  see  the 
actual  statements  that  read  the  user-supplied  input  can  always  find  them  in  subroutine  INISHL. 
Each  section  ends  with  a  listing  of  MAIN,  INISHL,  and  then  the  other  subroutines  of  that 
program  in  alphabetical  order.  There  are  several  subroutines  (e.g.  utility  routines  for  printing 
arrays)  which  are  used  in  two  or  more  of  the  NHM  programs.  These  are  listed  with  the  program 
in  which  they  are  first  used. 

The  numerical  computations  make  frequent  u.se  of  the  IMSL  library  (9*^  edition)*  of 
FORTRAN-callable  subroutines.  These  subroutines  are  used  to  perform  standard  mathematical 
operations  such  as  random  number  generation,  matrix  inversion,  and  solving  ordinary  differential 
equations.  The  IMSL  librar>'  is  likely  to  be  available  at  any  scientific  computing  center. 
However,  any  comparable  mathematical  software  library,  such  as  NAGLIB  ,  could  be  used  after 
minor  rewriting  of  the  code,  .'\ppendix  A  lists  the  required  IMSL  subroutines.  The  graphics 
routines  use  standard  "CalComp  Basic  Software^"  for  plotting  data. 

Acknowledgments.  The  .mthor  was  supported  in  this  work  by  the  Oceanic  Biology  Pro¬ 
gram  of  the  Office  of  Naval  Research,  under  contract  number  N00014-87-K-0525.  This  is 
Contribution  No.  44  from  the  Joint  Institute  for  the  Study  of  the  Atmosphere  and  Ocean  and 
Contribution  No.  1047  from  the  Pacific  Marine  Environmental  Laboratory/ NOAA.  Ryan 
Whitney  did  the  word  piucessing. 
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2,  PROGRAM  1 

A.  Program  Description 

This  program  does  the  ray  tracing  described  in  75/§9a  and  charted  in  75/Fig.  9  (i.e.  in  §9a 
and  Fig.  9  of  the  NHM  report). 

It  is  convenient  to  run  the  program  twice.  The  first  run  is  used  to  generate  and  save  a  file 
of  random  air-water  surfaces;  no  ray  tracing  is  performed.  The  second  run  then  reads  the  file  of 
surface  realizations  and  performs  the  ray  tracing.  This  two-step  procedure  allows  the  same  set  of 
realized  surfaces  to  be  repeatedly  used  in  the  ray  tracing,  as  follows.  Each  initial  ray  directed 
toward  a  ptirticular  input  quad  requires  an  independent  realization  of  the  random  water 
surface.  However,  the  rays  directed  toward  different  input  quads  Q  and  Q  can  \ise  the  same 
set  of  surface  realizations.  Moreover,  the  symmetry  of  the  water  surface  for  capillary  waves  (see 
75/§3f  and  75/Fig.  5)  allows  a  given  surface  realization  to  be  rotated  by  <J)  =  180°  in  order  to  get 
another  independent  surface  re,ilization.  One  can  also  turn  a  capillary  wave  surface  "upside 
down"  and  get  yet  another  iiuicpendent  suiiace  realization.  Thus  each  generated  and  stored 
capillary-wave  surface  can  be  used  four  times;  two  azimuthal  orientations,  each  "right  side  up" 
or  "upside  dow’n."  The  code,  as  listed  in  this  report  (see  statements  55  to  506  in  the  MAIN 
program),  makes  u.se  of  these  ssmmetries  so  that  if,  say,  lOOOO  rays  are  to  be  traced  for  each 
input  quad,  only  2500  surfaccv  need  be  generated  and  saved  in  the  first  run.  Note,  however,  that 
if  a  gravity-w  ave  spectrum  is  used,  one  can  no  longer  turn  the  surface  upside  down  and  get  a  new 
gravity-wave  surface  realization.  And  if  the  w  ave  spectrum  has  different  wave-slope  statistics  in 
the  downwind  and  upwind  directions,  then  one  cannot  rotate  the  surface  by  o  =  180°.  Thus  for  a 
fully  realistic,  mixed  gravity-ca;nllary  wave  spectrum,  one  must  generate  1(X)(K)  surface  realiza¬ 
tions  if  10000  rays  are  to  be  traced  for  each  input  quad  However,  these  surface  realizations 
(which  can  be  very  expensive  to  generate  for  a  mixed  gravity-capilliu’y  wave  spectrum)  can  still 
be  recycled  for  different  input  quads. 

The  net  result  of  Progicm  1  is  then  to  repeatedly  obtain  a  random  surface  realization, 
randomly  select  a  direction  in  ‘  and  send  a  parent  ray  tow  ard  and  the  realized  surface.  All 
the  reflected  and  refracted  d  chter  rays  are  traced  to  completion,  and  the  quads  receiving  the 
final  daughter  rays  are  determined.  One  parent  ray  is  sent  toward  each  quad  in  the  first 
quadrant  (of  the  wind-based  ^ystem  shown  in  75/Fig.  1)  for  each  stirface  realization,  until  the 
desired  number  of  surface  realizations  has  been  made.  For  each  (parent  ray  )-(daugiucr  ray)  pair, 
the  program  records  the  values  of  r,  s.  u,  v,  and  the  radiant  flux  ot  the  daughter  ray  (u,v  labels  the 
output  quad  receiving  the  final  daughter  ray).  These  ray-tracing  computations  can  form  a 
significant  part  of  the  entire  w  ork  of  the  NHM. 

Two  versions  of  MAIN  and  INISHL  are  included  in  the  code  listing  for  Programs  1  and  2. 
The  regular  version  of  these  tsvo  routines  (listed  first)  automatically  loops  over  all  first-quadrant 
input  quads  Q^.^,  sending  rays  toward  each  quad  in  turn  (but  using  the  same  surface  realizations 
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for  each  quad,  as  noted  tioove),  and  th-  eby  generating  all  the  ray  data  required  to  compute  the 
entire  quad-averaged  geometric  reflectance  and  transmittance  arrays.  This  version  of  Program  1 
is  to  be  used  for  prod  edon  runs. 

The  secoac  v-ersion  of  MAIN  and  INISHL  (listed  last)  is  a  "one-quad"  version,  which 
sends  rays  lowtu'd  only  one  input  quad  selected  by  the  user  (in  the  one-quad  version  of  record  2, 
belov  ).  The  ray  data  so  generated  lead  to  the  evaluation  of  only  one  row  of  the  reflectance  and 
transmittance  arrays.  If  the  ra>s  are  air- incident,  one  row  of  r(a,x)  and  t(a,x)  is  computed;  if  the 
rays  lu'e  water-incident,  one  row  (sf  r(x,a)  and  Ux,a)  is  computed. 

The  one-quad  versions  of  Programs  I  and  2  are  useful  for  determining  how  many  rays 
must  be  traced  to  achieve  a  gi\cn  accuracy  in  the  elements  of  the  quad-averaged  r  and  t  arrays, 
for  a  given  quad  resolution  ami  wind  speed.  This  determination  must  be  empirically  made,  and 
the  indw'idual  elements  of  the  ftr.slu.v)  arrays  approach  their  final  values  at  differing  rates  as 
more  and  more  rays  are  tabul.itcd.  (Here  f(r,slu,v)  represents  r(a,x;  r,slu,v),  or  any  of  the  other 
three  r  and  t  lu'iay.'.,)  l  or  j  vcn  mput  t;uad  ,  the  output  quads  which  are  near  the 
.^pecu!ar  (still  water)  retlectu'..  ir  rcfn-ction  ditcctions  of  the  parent  rays  in  will  receive  far 
more  reflected  or  transmitted  (uu.ghter  rays  than  those  quads  which  are  in  directions  far  from  the 
specuher  directions.  Thus  atto  only  a  few  hundred  surface  realizations,  .some  elements  of 
f(r,slu,v)  tnay  have  achicsed  I’leir  final  values  with  great  accuracy,  whereas  other  elements  may 
not  have  had  a  single  ray  pat.h  ■  cninect  the  particular  and  quads.  However,  those  ele¬ 
ments  which  are  largest  in  m.igniuide  (ioimnaie  the  behavioi  of  the  light  field  in  the  sea,  so  it  is 
not  necessary  to  know  all  m„t;  i  <  elements  to  the  same  degree  of  accuracy.  The  user  of  the  NHM 
IS  ihus  faced  w  ith  making  a  dec:'  ion  regarding  the  riesired  accuracy  of  the  elements  of  the  r  and  t 
arrays.  The  larger  matri.s  elements  can  and  must  be  determined  w'ith  great  accuracy,  but  the 
smaller  matrix  elements,  w  hicli  are  many  orders  of  magnitude  smaller  than  the  larger  elements, 
cannot  be  accurately  csiim.itc  ■  u.nlcss  a  tremendously  large  number  of  rays  is  traced. 

'I'hu'.  using  the  onc-tp.  vci  'ion.  one  can  make  a  series  of  runs  with,  say,  1000,  5000  and 
loOOO  air  uicidcin  rays  f'cii  :.'^c>:  for  .<  ;\:!.icuiar  inpu:  quad  The  computed  values  of 

r.s  u  \  )  an  i  igi.x  r.'-  ■:  v  i -■  1.  in  and  \  -  !  ,  -  .20  can  then  he  studied  to  see  how  quickly 

these  ,irT,!y  elements  achieve  ’.aluc' 

Other  '.peci.ili/cti  sltii!  -  -  an  be  e-  ; inomieally  performed  with  the  one-quad  version.  For 
cv.ing'le,  for  a  fixeil  n.irrib--  ;  r.r. ircnlent  >>n  rh  •  ■■'irfR  'e  ti'ward  a  given  quad  one  can 
Nt'uhc  th,  •  efects  ot  w  ind  ec,  ''h'  loOec'eil  refrtictcd  rays,  and  so  on. 

B.  Input 

Four  paramelci s.  win.  .tLcermir.;  m.!\:mien  arrav  dimensions,  must  be  .set  at  compilation 
time.  These  parameters  are  <  c  the  first  PARAMFTliR  statement  in  the  MAIN  program) 
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parameter 

value  in  listed  ci'de 

definition 

MXMU 

10 

the  maximum  number  of  quads  in  the 
|i-direction  in  a  hemisphere,  including  the 
polar  cap 

MXPHI 

24 

the  maximum  number  of  quads  in  the 
O-direction,  0  <  0  <  27t 

MXSTAK 

It) 

the  maximum  number  of  rays  in  the  push-pull 
stack  at  once 

MXNHEX 

7 

the  maximum  order  of  the  hexagonal  grid  used 
for  ray  tracing 

Refering  to  75/§3a,  MXMU  gives  the  maximum  allowed  value  of  m  (=  NMU,  below),  and 
MXPHI  gives  the  maximum  value  of  N  (=  NPHI,  below).  Figures  75/4a,  75/4b  and  75/4d  show 
quad  partitions  for  which  m  =  If)  and  N  =  24.  A  run  using  the  quad  partitioning  of  75/Fig.  4c  has 
m  =  23  and  N  =  60,  as  so  would  require  MXMU  >  23  and  MXPHI  >  60.  For  efficient  use  of 
computer  storage,  one  should  pick  MXMU  and  MXPHI  to  be  the  same  as  the  actual  number  of  )J. 
and  0  cells  in  the  quad  partitioning,  NMU  and  NPHI,  respectively,  to  be  specified  in  record  2, 
below.  The  value  of  MXSTAK  =  10  should  be  sufficient  for  any  problem  (see  63/page  11,  i.e. 
page  1 1  in  the  ray-tracing  report).  MXNHEX  =  7  is  sufficient  for  simulation  of  capillary  wave 
surfaces.  75/Fig.  8  and  6.3/Fig,  5  each  show  hexagonal  grids  of  order  two  (NHEX  =  2).  Proper 
resolution  of  mixed  gravity-capillary'  waves  requires  high-order  hexagonal  grids  (NHEX  of  100 
or  more),  and  so  MXNHEX  must  be  increa.sed  accordingly  if  such  studies  are  to  be  made. 

Two  or  three  free-formai  data  records  are  read  at  execution  time  (see  subroutine  INISHL). 
In  es.sence,  the  first  record  specifies  the  water  surface;  the  second  (and  optional  third)  specifies 
the  quad  partitioning  and  the  number  of  rays  to  be  traced.  The  records  are  as  follows: 

Record  1 :  IDBUG.  IGENSF.  MIEX.  WNDSPD,  DSEFD 

IDIU  G  =  0  for  minimal  output  (production  runs) 

=  1  for  greater  ouqiut 

=  2  for  full  debugeing  output 

IGE.NSF  =0  i  a  tde  of  random  surfaces  already  exists,  and  is  to  be  used  for  ray 

tracing 

>  0  it  this  is  an  initial  run  for  generating  and  saving  a  file  of  random 
surfaces.  The  value  of  IGENSF  gives  the  number  of  surfaces  to  be 
generated  (IGENSF  =  2500,  .say). 

NHEX  gives  the  order  of  the  hexagonal  surface  grid  (NHEX  =  7  is  adequate  for 
capillary  waves). 
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WNDSPD  gives  the  wind  speed  for  use  in  the  wave  spectrum,  e.g.  WNDSPD  =  10.0  for 
a  10  m  s  ”  wind  at  12.5  m  elevation  (see  63/page  15). 

DSEED  is  a  double  precision  seed  for  the  IMSL  random  number  generators,  e.g. 
DSEED=  18762203.D0 

If  IGENSF  >  0,  only  record  1  is  required. 

Record  2:  NMU,  NPHI,  MUPART,  NREADO,  NUMRAY 

NMU  gives  the  number  of  p-cells  in  one  hemisphere  in  the  quad  partitioning  (the 

value  of  m  on  75/page  20). 

NPHI  gives  the  number  of  (t)-cells  in  the  quad  partitioning  (the  value  of  N  on 

75/page  20).  NPHI  must  be  a  multiple  of  4. 

MUPART  selects  the  scheme  for  |j.-partitioning  of  the  unit  sphere  (see  75/page  22-24), 
as  follows: 

=  1  if  all  quads  are  to  have  equal  solid  angles 

=  2  if  all  quads  are  to  have  equal  A0  values 

The  user  may  write  subroutines  to  define  other  quad  partitions,  using 
other  values  of  this  variable  to  select  the  desired  subroutine. 

NREADO  =  1  if  the  file  of  stored  surface  realizations  is  to  be  read  from  the  start  (the 
usual  case) 

=  2,  3  or  0  if  the  file  is  to  be  read  starting  with  a  rotation  or  inversion  of  the 
stored  surfaces  (this  can  be  useful  if  additional  rays  are  to  be  traced 
and  complete  use  of  the  stored  surfaces  has  not  yet  been  made) 

NUMRAY  gives  the  number  of  rays  to  be  traced  from  each  input  quad 

if  NUMRAY  <  0,  then  a  third  record  is  used  to  give  the  number  of  rays  to  be 
traced  from  quads  in  each  p-band. 


Record  2a:  NRAYQD(l),  NRAYQD  (NMU) 

This  record  is  read  only  if  NUMRAY  <  0  in  record  2. 

NRAYQD(l)  gives  the  number  of  rays  to  be  traced  from  each  input  quad  in  the 

p-h;md  neare.st  the  equator  (r  =  1),  and  so  on  until 

NRAYQD(NMU)  gives  the  number  of  rays  to  be  traced  from  the  polar  cap 
(r  -  m  =  NMU) 


Record  2a  can  be  used  if,  for  example,  one  wants  to  trace  a  certain  number  of  initial  rays  per 
steradian,  but  the  quads  have  different  solid  angles  in  the  various  p-bands.  Or,  if  it  is  found  in 
preliminary  studies  (e.g.  with  the  one-quad  version)  that  more  rays  must  be  traced  from  quads 
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near  the  equator  than  from  quads  near  the  polar  caps,  in  order  to  achieve  the  desired  accuracy, 
then  record  2a  must  be  used. 


Record  2,  one-quad  version:  NMU,  NPHI,  MUPART,  IR,  JS,  NUMRAY 
NMU,  NPHI,  MUPART  and  NUMRAY  are  as  above.  IR  and  JS  give  the  values  of  r  and  s, 
respectively,  specifying  the  input  quad  Q^.  If  IR  is  positive,  1  <  IR  <  NMU,  the  rays  are  air- 
incident.  If  IR  is  negative,  -NMU  <  IR  <  -1,  the  rays  are  water-incident.  JS  must  be  in  the  first 
quadrant,  i.e.  1  <  JS  <  NPHI/4-f-l. 


C.  File  Management 

Throughout  the  NHM,  files  are  given  a  symbolic  (alphanumeric)  filename  beginning  with 
"NU"  (e.g.  NUSFC  for  the  file  containing  the  surface  realizations),  as  well  as  an  external 
filename  of  the  form  "TAPEXX",  where  XX  is  a  FORTRAN  logical  unit  number  (e.g.  TAPE  15 
is  the  file  NUSFC).  This  naming  scheme  is  appropriate  for  CDC  computers,  but  may  require 
minor  modification  on  other  machines.  User-supplied  input  is  always  read  from  unit  5  (INPUT, 
or  TAPES)  and  printout  is  written  to  unit  6  (OUTPUT,  or  TAPE6),  in  accordance  with  standard 
FORTRAN  conventions. 


Program 

1  creates  the  following  five  files: 

symbolic 

external 

filename 

filename 

description 

NUSFC 

TAPE  15 

the  file  of  random  surface  realizations;  created  in  the 
initial  run  of  Program  1,  and  read  in  the  ray-tracing 
run  of  Program  1 

NUDU 

TAPE  16 

a  ray-data  file,  containing  initial  and  final  ray  direc¬ 
tion  and  radiance  information,  for  initial  rays 
downward  and  final  rays  upward.  Created  in  the 
second  run  of  Program  1  and  used  to  compute 
r(a,x;  r,slu,v) 

NUDD 

TAPE  17 

ray  data  file  for  initial  rays  downward,  final  rays 
downward;  used  to  compute  t(a,x;  r,slu,v) 

NUUD 

TAPE  18 

ray  data  file  for  initial  rays  upward,  final  rays 
downward;  used  to  compute  r(x,a;  r,slu,v) 

NUUU 

TAPE  19 

ray  data  file  for  initial  rays  upward,  final  rays  up- 
ward;  used  to  compute  t(x,a;  r,slu,v) 

Program  2  reads  the  four  ray-data  files  and  tallies  the  inform ition  to  generate  the  quad- 
averaged,  geometric  reflectance  and  transmittance  arrays. 
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D.  Code  Listing 

Each  subroutine  begins  with  a  brief  description  of  its  purpose. 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

(- 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


c. 

L 


PROGRAM  MAIN( INPUT , OUTPUT .TAPe6-lNPijT.TAPE6=0UTPUT,TAPE16, 
1  TAPE  16 . tape  17 . TAPE  lb . tape  19 ) 


+  +  +  ♦  + 


+  THIS  IS  PROGRAM  1  OF  THE  NATURAL  HVDROSOL  MODEL  ♦ 


ON  NHMI/MIALL 

THIS  PROGRAM  BEGINS  COMPUTATION  OF  The  (jEOMETRIC  REFLECTANCE  AND 
TRANSMITTANCE  ARRAYS  WHICH  DESCRIBE  ThE  AIR-wATER  INTERFACE  FOR 
A  GIVEN  WIND  SPEED. 

THIS  standard  version  OF  MAIM  DOES  all  INPUT  UUADS  IN  THE  FIRST 
QUADRANT 

NOTE:  This  vers. UN  Of  The  code  strives  to  minimize  The  EXECUTION 

TIME,  AT  The  expense  C'F  MOOuLARITv  AND  READABILITY  OF  ThE  CODE. 
SOME  SECTIONS  OF  FREQUENTLY  EXECUTED  CODE  ARE  WRITTEN  AS  STRAIGHT 
line  code  WITH  simple  variables.  RAThER  Than  BEING  GROUPED  IN 
subroutines  OR  DC  LOOPS  wITh  ARRavs.  IN  ORDER  TO  AVOID  CALLING 
AND  indexing  Overhead.  almost  ail  ErRlIR  CHEcpING  and  INTERMEDIATE 
OUTPUT  HAS  BEEN  REMOVED. 

THIS  PROGRAM  USES  THE  MONTE  lARiu  RAv  IRALING  TECHNIQUE 
DESCRIBED  IN  NOAA  TECH  MEM.)  ERi  PMEi -»J.  tUMMENTS  REFERRING  TO 
THIS  REPORT  are  PREFACED  BY  fcj'.  ThuS  bj/Z.JZ  REFERS  10 
EQUATION  2.12  IN  ’’ECh  MEMO  ci 

references  WIThU.jT  The  6.J/  REFER  'u  tu.AA  TELH  MEMO  ERL-PMEL-75. 
NUSFC  =  TAPE15.  .contains  THE  RANDOM  SURFACE  REALIZATIONS 


RESULTS  OF  C0M;_lT£0  RAY  PA’hS  A^E  dvRITTEN  TO  FILES  AS  FOLLOWS; 


NUOU  =  TAPE16. 

.initial 

RAV 

DOv^ftwARU  . 

F  INAL 

RAY 

UPWARD : 

R  - 

NUDD  =  TAPEI?. 

. INITIAL 

RAV 

DOWNWARD . 

FINAL 

RAV 

DOWNWARD ; 

T- 

NUUD  =  TAPE18. 

.  initial 

RAY 

UPWARD . 

final 

RAV 

DOWNWARD  ; 

R  + 

NUUU  =  TAPEI9. 

. INI riAL 

RAV 

mPwARO . 

FINAL 

RAY 

UPWARD : 

R(A,X) 
T(A ,X) 
R(X, A) 
T  {  X  .  A  ) 


program  2  REAU^  'hESE  FILES  AND  I  A l L  I E S  THE  RESULTS  TO  uENERATE 
The  actual  R  A'..,  T  ARRAYS. 


PARAME TER (MXM:  :S,  MxPHI=24.  RVs'Ap-Iu,  MxnhEX=7) 
PARAMETERIMXnUDE  -  J  ‘MANHEX*  I  Mx.nhEx-'  MxnTIP-AfMxNhEx-*!) 


COMMON/^MjPhl  ,  -iNDMJ(MXMu)  .BNUkhI  (M>lPhI  ) 

COMMON/ r.NOOe  S/  NNODE.FnOOEI  Z.MxNJuE  I  .  ZNOOE  (  MXNOOE  ) 

COMMON  /  ChEXGR/  •.•-'EX,fil(?).R2(2).RlHATiv).R2HAT(2).RlRAT.TARGET(2) 
COMMON  /  C  "  1  P/  ■  I  P  .  SMI  N  .  YT  1  P(  2  .  Man  '  I  P  I  .  s  I  MxM  1  P  )  ,  F.S  (  MXNT  I  P  )  ,  ZMI  N  , 

1  Z'.'Ax 

COMMON  /  ;.  ST  A(  )>  NST  ACX  .  STACp  I  MXS  I  A  A  ,  1 

COMMON ' CM r  SC  /  ; mi  sc ( 20 1 . fmi sc ( uo ■ 

DIMENSION  /.'In  ;/.XIiNl3).Pf3),AlPLrL:  i..xIREER(.l) 

DIMENSION  nRAal^DIMXMu)  ,NBRnCh(  Kii 

uuuBlE  precision  DSEED 


DATA  RADEPs/I.lE'IO/  .  N0SFC,Nuu'..N'iUt/,)4uuD.)VL,UU^lS,  16.  1/.  18,19/ 
data  NSTACA/O/,  KTRACE/0/.  NBPNCh/  li.Aiw  .  NPFFi  0  .  NRE  FRi:  ,  NT  1  R  /  3*0  / 

initialize  the  program 


I.All  1  N  I  SHI  (  NR  E  ADO  ,  NRA  YQD  ,  DSt  ED  / 
NM J  -  1 M I  SL  I  i  I 
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NPHI  =  IMI  t>(;  I  ^  ) 

PI  =  FMi sc (  1  j 

rwopi  -  2.o*Pi 

JPI2  =  NPHI/4  ■>■  1 

DPMINP  =  BNDPl-(l(2)  -  BNOPHHl) 

NUMDU  -  0 
NUMDD  =  0 
NUMUD  =  0 
NUMUU  -  0 
NUMTPI  -  0 

BEGIN  computations 

N.B.  I  AND  J  LABEL  THE  INPUT  QUAD.  WHICH  IS  THE  QUAD  RECEIVING 

the  Photons  (xi  prime  is  the  direction  of  photon  travel). 

LOOP  OVER  Mu  PRIME  CELLS  (THETA  =  -PI/2  TO  -PI/2) 

00  1001  I=-NMU,NMU 
I F { I  . EO . 0 )  GO  TO  lUO  1 

GET  MU  PRIME  BOUNDARIES  OF  THE  INCOMING  UUAD 
FMUMIN  =  0. 

I  A  =  I A85(  I  ) 

IF(IA.GT.l)  FMUMIN  i  BNDMU(IA-I) 

OMU  -  0NDMU(IA)  FMUMIN 
NUMRAV  NRAVUUi  I  A  ) 

I F  (  I  A  .  EU  ,  NMU I  'MEN 

IF  I  ISA  polar  Cap.  DO  ONLV  J  =  1  index 

jCOMP  -  1 

PH  I  MIN  -  0, 

OPHI  =  TWOPI 

else 

FOR  NON-POLAR  QUADS.  DO  ONLV  FlhsT  QUADRANT  (0  .LE.  PHI  PRIME  . L£ .  Pl/2) 

JCUMP  =  JPI2 

PHIMIN  =  BNDPHlINPHl) 

OPHi  =  OPHINP 
ENDIF 

LOOP  OVER  PHI  PRIME  cells  (0  .LE.  Pul  PRIME  lE.  PI/2,  OR  2*PI  IF  POLAR  CAP) 
DO  1000  J- 1 , JCOMP 

IF(j.tjT.l)  PMIMIN  =  0NDPHl(J-n 

LOOP  OVER  The  random  starting  points  within  the  quad 

note  that  different  quads  may  have  different  numbers  of  rays  traced 

REWIND  NUSFC 
REAO(NUSFC)  header 
READ( NUSFC )  HEADER 
NREAD  =  NREADO 
DO  1000  NR AY=  1  . NUMR A Y 
t 

c  select  a  Surface  realization 

L 

5B  continue 

I F ( NREAD . EQ . 1 i  TmEN 

(,  READ  A  surface  REALiZATIOrj  AS  I^EritRATED 

RE  AL)  I  NuSFC  .  END  -  SO  )  NSF  ,  ZM  I  N  .  ZMA  x  .  (  ZTtODE  (  I  Z  ;  .  I  Z  =  1  .  NNODE  ) 

C 

t'.  j£  I  F  (  NREAD  .  E'w  .  2  J  Then 

L  READ  The  SURFA'  t  AS  ROTATED  By  IMij  LjEoREES 

READ  f  N jSFC , END  =  S0 ;  NSF , ZM I N . ZMA x ,  ( ZNODE ilZ),IZ  =  NNODE.l.  l) 

Else  I  F  (  NREAD  .  FO  ..)  )  THEN 
c  READ  The  Surface  and  invert 

READ! NUSFC, END- SO)  NSF.ZMIN.ZMAx. ( ZNuDE ( I Z ) , I Z- 1 , NNODE ) 

DO  S02  IZ=1,NN&DE 
502  ZNODE(IZ)  =  -ZN0DE(I2) 

C 

else  IF f NREAD . EO . 0 )  THEN 

L  HEAD  The  SURFACE  AS  ROTATED  BY  ibu  UEuREES  AND  THEN  INVERT 

READ(NUSFC.END  =  50)  NSF.ZMIN. ZMAX ,  ( ZNODE I  I Z )  .  I Z  =  NNODE ,1.-1) 

DO  504  IZ=1, NNODE 
504  ZNODE(IZ)  -  -ZNODE(IZ) 

ENDIF 
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c 

GO  TO  506 

C  END  OF  file  processing  FOR  TmE  STORED  FluE  OF  CAPILLARY  SURFACES 

50  WRITE(b.514)  NREAD.NUSFC 
NREAD  =  NREAD  +  I 
NREAO  =  MODCNREAO.A) 

REWIND  NUSFC 
READ(NUSFC)  HEADER 
READ(NUSFC)  HEADER 
GO  TO  55 
506  continue 

CHOOSE  A  RANDOM  MU  PRIME  VALUE 

I  POSITIVE  (NEGATIVE!  GIVES  UPWARD  (DOWNWARD)  RAYS  WITH  MU  PRIME 
XI  PRIMEO)  =  aIINITi  POSITIVE  (NEGATIVE) 

777  RMU  =  (FMUMIN  DM(  *GGu8F  S  (  OSEED  ))•  S 1  GN  (  1 . 0  .  F  LOAT  (  I  )  ) 

NO  RAYS  FROM  THE  POlE  ITSElF 

IF ( ABS(RMU)  . GT .  1  . O-RAOEPS )  GC  TO  777 

ROOT  =  S0RT(1.0  -  RMU’RMU) 

CHOOSE  A  RANDOM  Pm ;  vAluE 

SPHI  =  AM00(PHIM1N  »  GGuBF5l DsEED ) ♦DPMI . TWOPI ) 

define  a  temporary  RAY  Ab  -XI  PRIME.  AND  FOLLOW  THIS  RAY  TO 
THE  eOUNOAfiv  TO  (j£T  SMIN 
XIIN(I)  =  -ROOT»i:OS(  SPHi  ) 

XIIN(2)  -  -R00T*SIN(SPHI ) 

XIIN(3)  =  -RMu 

call  t I pt f arge t . ^ ; n . 0 ) 

DEFINE  The  IMTIA.  POINT  UN  TmE  mEaAGUN  BOUNDARY 
TEMP  =  SMIN/FMI SCI  20  ) 

PIN{1)  =  TARGETMI  ♦  TeMP»XllNIlJ 
PIN(2)  =  TARGETi2)  ♦  TEMP’XIlNici 
PIN(  3  )  =  rEMP»Xl  I  .N(  3  I 

RESET  XllN  10  T-f  DESIRED  iNLlUEtU  RAv  DIRECTION,  XI  PRIME 
(THE  direction  PP’  Photon  TRAvti.  ) 

XIlN(ll  -  -XlINf.) 

X  I  I  N  (  2  )  =  •  X  I  I  '  2  ; 

X  I  I  N  (  3  )  =  -  X  I  I  N  I  .w 
RAO  ^  l.Q 
INRAY  i  I 

PERFORM  RAV  TRACINu  COMPUTATIONS 

This  is  the  R!:(. mrsIve  tree  for  a  given  initial  ray  »•►■>■+■» 

KBRNCh  =  0 

999  CALL  trace ( INRAV . RAO , PIN , HI  IN .  I OuT , P , RREF L . X  I R E F L . RRE FR . X  I  RE FR ) 
KTRACe  -  kTRACE  1 
KSRnCH  =  K8RNCH  ♦  1 
INRAy  i  0 

CHECK  FOR  RAY  M^ylNG  left  TmE  HbXAuON 

IF ( TOUT . EC . 1 )  'mEn 

RAY  HAD  NO  FAl  :  INTERCEPTS. 

GET  THE  QUAD  INDICES  OE  ^HE  FINAL  RAv  DIRECTION 
PhIFIN  =  AVtCD;  aTAN2(XI  IN(  2)  .  VI  iNi  1  )  )v  rwOPI  .  TwOPI  ) 

AMUF IN  =  X  I  I N I  ;  , 

call  MPINDx(AM.f-lN,PHIFlN.K,L) 

RECORD  The  fiES.LT  FOR  THE  APPROPRIATE  R  OR  T  CONTRIBUTION 

I F (  I  . LT . 0  )  THEN 

DOWNWARD  INITIAL  RAV 
I F ( AMUF IN . GT . G . u j  THEN 
C  UPWARD  FINAL  RAv 

NUMOU  -  NUMDU  ♦  1 

WRITE(NUDU)  '  1  ,  ,  K  ,  L  ,  RAD 

ELSE 

C  downward  final  RAV 

NUMDD  =  NUMDD  •  ! 

WRITE(NuDD)  I.^.X.l.RAD 
ENOIF 
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c 

Else 

UPWARD  INTIAL  RAV 

if(aMufin.gt.o.O)  Then 

UPWARD  final  RAV 

IF (RAD. EQ. 1.0)  THEN 

ERROR  RAV.  DUE  TO  FINITE  HEXAGON 

NUMTPI  =  NUMTPI  +  1 

Else 

NUMUU  =  NUMUU  +  1 

WRITEINUUU)  i.j.k.l.rad 
ENDIF 

else 

DOWNWARD  FINAL  RAV 
NUMUO  =  NUMUD  ->■  I 

wRiTE(Nuuo)  I.j.k.l.rad 
enoif 

ENDIF 

ELSE 

RAV  intersected  A  FACET.  PlJSH  REFLECTED  AND  REFRACTED  RAVS  INTO 

STACK  FOR  Further  tracing,  (discard  ravs  with  radiance  .le.  radeps) 
if(rrefl.gt.radeps)  Then 

CALL  PUSH( RREFl . P . X r REFl  ) 

ELSE 

NREFLO  =  NREFlO  ^  1 
ENOIF 

IF(RR£FR .GT. RADEPS)  ThEN 
CA(.L  PUSH(fiR£FR  ,  P.XIREFR) 
eLSEIF(RREFR.LE.O.O)  THEN 
NTIR  -  NTIR  ♦  I 
ELSE 

NREFRO  -  NREFRO  ■>  1 

ENDIF 

ENDIF 

HAVE  ALL  RAVS  BEEN  FOLLOWED  TO  TERMINATION 

if(nstack . GT , 0;  then 

READ  A  NEW  RAV  FROM  ThE  STACK  AND  TRACE. 

call  pull ( rad , pin , XI  IN) 

GO  TO  999 
ENDIF 

THIS  IS  The  end  of  the  recursive  TREE  FOR  THE  GIVEN  INITIAL  RAV  + 
IF ( KBRNCH . LT . 10 )  then 

NBRNCH(K0RNCH)  -  NBRNCH(  KBRNCH)  1 
ELSE 

NBRNCH(IO)  =  NSRNCHllO)  1 
ENDIF 

1000  continue 

1001  continue 

END  OF  computations  *»*•» 

ENDFIlE  NUDU 
ENDFIlE  NUDD 
enDF I le  nuuO 
ENDFIlE  NUUU 

NRA vTl  =  I  MI  SC i  1  7  ) 

WRITE(6,600)  NRA vTl . KTRACE 

WRITE(6,6D1j  NREFlO, RADEPS. NREFRO. radeps, NTIR 
WRI T£ ( 6 . 602 )  NuMDU , NuMDO. NUMuO. NUMUU . NUMTP 1 
WR I TE ( 6 . 604 )  (K,K=2,10), (N0RNCh( K ) . K=2 , 10 ) 

WRITE(6.605) 
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c 

c  FORMATS 

C 

514  F0RMAT(1H  NREAD  =  ,I2,SK, 

I'FILE  OF  SURFACE  REALIZATIONS  EXHAUSTED.  UNIT', 13.'  REWOUND.') 

600  FORMAT! IHO,'  END  OF  RAV  TRACING  COMPUTATIONS'/ 

21H  .110,'  total  RAVS  were  STARTED  IN  TmIS  RUN'/ 

31H  .110,'  total  RAVS  WERE  TRACED  To  COMPLETION') 

601  F0RMAT(1H  .15.'  REFLECTED  RAVS  wllH  RADIANCE  .LT.  ,1PE9.1. 

1'  WERE  01 SCAROED ' / 1 6 . '  REFRACTED  RAvS  w ] Th  RADIANCE  LT.'. 

2E9.1.'  WERE  DISCARDED  / IH  .110. 

3'  total  internal  REFLECTIONS  OCCURRED) 

602  FORMAT! iri  ,110,'  RAVS  STARTED  DOWNWARD  AND  FINISHED  UPWARD'/ 

IIH  .110.'  RAVS  STARTED  DOWNWARD  ANU  FINISHED  DOWNWARD'/ 

21H  .110.'  RAVS  STARTED  UPWARD  AND  FINISHED  DOWNWARD'/ 

31H  .110.'  RAVS  STARTED  UPWARD  AND  FINISHED  UPWARD'/ 

41H  .110.'  RAVS  STARTED  UPWARD  AND  FINISHED  UPWARD  WITH  RAO  =  1 

5.0  (DISCARDED) ' ) 

604  FORMAT!1HO.'  BRANCH  OCCURRENCE  TAlLY'//'  NUM  BRANCHES: 

18110.17.'  OR  MORE'/'  NUM  OCCURRENCE S :'. 9 1  10 ) 

605  FORMAT! IHO.'  NORMAL  EXIT  FROM  NHM ,  PROGRAM  1.') 

END 


L 

L 

C 

C 

C 

c 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

r 

c 

c 


c 

1. 

c 

r 

c 

c 

c 


SUBROUTINE  INIS.Hi  .  NR  E  A  DO  .  NR  A  VOD  ,  UsE  E  D  ) 

ON  NMMI/INIAlL 

THIS  routine  initializes  NHM1/M1a:.l 
TWO  INPUT  RECORDS  ARE  READ: 

RECORD  1  (DEFINES  THE  HEXAGON  GRID  AND  The  WATER  SURFACE): 

IDBUG  =  0  FOR  MINIMAL  OUTPUT 
=  1  FOR  GREATER  OUTPUT 
=  2  FOR  Full  DEBUGGING  OU''PuT 

IGENSF  -  0  IF  A  FIlE  OT  RANDOM  S:jRFA(.Es  ALREADY  EXISTS  (USUAL  CASE) 

.  GT  .  0  IF  'Mis  IS  A  SPECIa;,  RUN  FI.IR  GENERATING  AND  SAVING  A 

FIlE  OF  RANDOM  SURFACES.  IGENSF  SURFACES  WILL  BE  GENERATED. 
NHEX  =  The  order  of  The  hexagonal  •>urface  grid  (=  mxnhex  for  efficiency) 
WNDSPD  =  The  .■;!  D  SPEED  IN  M/SEC  AT  12.5  M  ELEVATION 
USEED  =  The  seed  FOR  RANDOM  NUMBER  GENERATION 

RECORD  2  (DEFIihES  THE  QUAD  GRID  AND  i^ELECTS  RAY  PARAMETERS): 

NMU  =  the  number  of  Mu  cells  In  UNE  hemisphere  (0  TO  PI/2) 

NPHI  =  The  number  OF  PHI  CEllS  (0  TO  2*Pi).  MOST  BE  A  MULTIPLE  OF  4 
MuPART  =  1  IF  c,Li.  QUADS  ARE  TO  mAvE  EOuAl  SOLID  ANGLES 

2  IF  A^^  QUADS  ARE  TO  HAvf.  EQUAL  DELTA  THETA  VALUES 

NREADo  =  1,  IF  the  Surface  realizatkjn  file  (nusfc)  is  to  be  read 
FROM  ^HE  beginning 

=  2,  3.  OR  0.  IF  NUSFC  IS  BE  READ  STARTING  WITH  A  ROTATION 

OR  INVERSION  (SEE  LOOP  55  IN  MAIN) 

NUMRAV:  IF  Nu '.(fi  A  /  .  G  T  .  0  .  NUMRAV  TS  THE  NUMBER  OF  RAVS 

TO  BE  SENT  FROM  EACH  INPlJT  QUAD  (NRAVQD(IR)  =  NUMRAV) 

IF  numrav.lt.o.  the  next  record  gives 

NRA  VQO!  I  R  )  .  I  R-  1  .  2 . NMu 
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PARAMETER tMXMU= 10 ,  MXPhl-24) 

PARAMeT£R(MXNMEX  =  7  .  MXNODE  =  3*MXNfiEX*  (  MXNmEX-^  1  )  ♦  1) 

COMMON/CMUPMl /  BNDMUtMxMU) .BNDPrtI {MXPMl J 

COMMON  /  ChEXGR/  NHEX  ,RU2).R2(2)  .R  iMAT  (  2  I  .  R2HAT  C  2  )  ,  R  IRAT  ,  TARGET  (  2  ) 
COMMON /CNOOES/  NNODE . FNODE ( 2 . MXNODE ) . ZNOOE(MXNOD£ ) 

COMMON/ CM I  SC/  I  MI  SC ( 20)  . FMl SC ( 20 ) 

DIMENSION  FMU ( MXMU )  , PHI  (MXPhI)  , OMEGA ( MXMU )  . DELTMU  tMXMU )  . 

1  NRAVOD(MXMU) 

DATA  PI  .DEGRAD, RADEG/3.  141Sy2ob4.  u . U 1  745320252 ,  5  7.295/795/ 

DATA  REFR/ 1 . 333333333/ 

DATA  delta.  EPS/1.0.  1.111/.  T  AR(.>t  T  /  0 . 5  .  0.370333333/ 

DATA  NUSFC  ,  NUDU  .  NUDD  ,  NULJD  .  NUUU  /  15.  16  .  .17,  18  ,  19/ 

READ  The  input  RFCOROS 

READ! 5 . » )  I DBUG , I GEnSF , NhEX . wNDsPD . DSEED 
WR1TE(6,300)  Nt-iEx  ,  WNOSPO  .  DsEED 

I  F (  IGENSF . EO . 0 )  THEN 

READ(5,*J  NMU.NPhI .MUPART.NREADu. NuMRAV 

I F ( NUMRAV . LT . 0 )  TmEN 
RE»ni5.*)  ( NRA vgO ( I R )  . I R=  1  . NMU) 

ELSE 

DO  40  IR=1,NMU 
40  NRAvOO(IR)  -  NjMRAV 
FNDI  F 

GET  The  total  number  of  ravs  to  be  traced 

NUMRAV  i  0 
DO  1  luu  I  -  1  ,  NMv.  ■  1 
1100  NUMRAV  =  NUMRAV  »  NRAVOO(l) 

NUMRAV  =  2* ( NUMLA V* ( NPhI /4  »  1)  »  NRAvODINMu)) 

WR  I  TE  (  6 , 30  1  )  NM'j  ,  NPHI  ,  NREADO  ,  NUMRA  v 
ENOI  F 

STORE  the  needed  PARAMETERS 

I  MI  SC (  1 J  =  NMU 
IMISC(2)  =  NPhI 
IMISC{9)  =  IDEUG 
I  MI  SCI  17 )  =  NUMRAV 

FMISC(  1)  =  PI 
FMISC(2)  =  DEGRAO 
FMISC13)  =  RADEG 
FM I  SC (  15 )  =  WNOSPD 

FMISC( 16)  =  DElTA 
FMISCI 171  =  EPS 
FMI SC (  18 )  =  REFR 

RAD48  IS  THE  lRI’ICAL  ANGLE  FOR  TOTal  INTERNAL  REFcECTlUN 
RAD48  =  AS  1 N (  1  . 0 / REFR ) 

FMI  SC  I  19  )  =  RAl'OS 
L 

IFIIGENSF.GT.C- 

L 

*  t  ♦  TmI  S  IS  AN  INI’IA;.  RUN  FOR  generation  OF  A  FIuE  OF  RANDOM  SURFACES 

wR I TE ( 6 . 3C4  ) 

REWIND  NuSFC 

C  check  to  see  if  NjSFC  IS  EMPTv 

R  E  A  D  ^  N u  S F  C  .  E  Ni>  -  50  )  DUMMY 

STOP  Surface  file  already  ex1i>ti> 

5U  rewind  NUSFC 

c 

(.  define  grid  vectors  as  in  b3/PAGES  24-26 

c 

GAMMA  1  =  1  .  0/ SORT  (  0 , 25*DEL  TA*C)El  TA  »  ERS’ERSI 

RUl;  =  0 . 5*DElTA*GAMMA1 
R 1 (  2  I  =  £PS*GAMMA 1 
R  2  (  I  )  =  -  R  1  '  I  ; 

R  2  (  2  I  -  R  1  (  2  ) 

R  IHAT {  1 )  =  - R  1  I  2  ) 

R IHAT (  2 )  =  R  1  i  !  I 
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c 

c 

c 


c 

c 


r 


L 

( 


L 


c 

r 

c 


I 

I 


c 


c 

c 

c 

c 

c 


L 


t 

c 


c 

c 

L 

c 

c 

c 

c 

c 


R2HAT( 1 )  =  -R2( 2) 

R2hAT{2J  =  R2(l) 

RIRAT  =  -2 . 0»EP'; /delta 

DEFINE  the  hexagonal  SURFACE  GRID  NUDE  LOCATIONS 

PMISCI 16J  =  DELTA 
LMISCd?)  =  EPS 
call  TRIADS(NHEX) 

WRITE  the  header  RECORDS 

WRITE(NUSFC)  IGENSF.NMEX, NNODE . wNDSPu . DSEED 
WRITE(NUSFC)  RI,R2,R1HAT, R2HAT .RIRAT , FNOOE 

define  The  STANDARD  DEVIATION  FOR  SURFACE  HEIGHTS  BV  63/2.12 

SlGSFC  -  (J  .  039  7  *  SOR  T  (  WNDSPD  ) 
wRITE(6,J02)  del t a , EPS . SIGSFC 

generate  and  sa.'E  the  capliiarv  wale  surface  realizations, 

63/SECTION  2C 

DO  55  NSFC= 1 , IGENSF 

DRAW  N(O.l)  random  NUMBERS 
CALL  GGNML ( DSEt j . NNODE . ZNODE ) 

CONVERT  TO  N(0  SIGSFC**2)  RANUuM  NUMBERS 
ZMAX  =  -l.OE.TO 

ZMiN  =  i.cesn 

DO  99  IRAN=1.NN0DE 
ZN  =  SIGSFC*ZN0DE ( IRAN) 

ZNODE(IRAN)  =  ZN 
IF(ZN.GT.ZMAX)  ZMAX  =  ZN 
I F ( ZN . LT . ZMIN )  ZMIN  =  Zu 
99  continue 

55  WRITEINUSFCI  NSi^  .  ZM  I  N  ,  ZMAX  .  (  ZNUDE  (  I  )  .  I  =  1  .  NNODE  ) 

ENOFIlE  NUSFt 
WRITE(6,60)  IGENSF 
STOP 
ENDI  F 

••‘THIS  IS  A  production  run  FOR  RAY  TRACING 

READ  the  existing  FIlE  OF  SURFACE  REAL  I ZA^"  I  OnS  AND  TEST  FOR 
COMPA TAB  I L I  TV  with  REQUESTED  PARAMETERS 

WR I TE ( 6 . 308 ) 

REWIND  NUSFC 

REAOiNUSFC)  NSf=i,NHe>l,  NNODE  .  Wl  NDl 
R£AD(NUSFC)  R1,R2.R1HAT , R2hAT  . R  IRA  I  , ENOUE 

I F ( NHEX 1 . NE . Nrti \  .OR.  WI ND I . NE . WNDSPD )  THEN 
WRITE(6.70)  NH'-^l.wINDl 
STOP 
END!  r 

DEFINE  The  M  '  and  PhI  VAlilES  WHICH  FORM  THE  QUAD  BOUNDARIES  FOR 
GEOMETRIC  D .  sCR £ T I Z A T I  ON  (SECTION  3). 

I F (MUPART . EQ . I '  Then 

PARTITION  The  i^NIT  SPHERE  SO  THAT  All  QUADS  HAVE  EQUAL  SOLID  ANGLES 
call  eqsang (  nm.)  ,  nphi  .deltmu  ) 

ELSEI  F  (  MUPART  .  2  )  THEN 

PARTITION  the  UNIT  SPHERE  INTO  EQUAli.  V  SPACED  theta  values 
call  eothet ( nm, ! , del tmu ) 

CNDIF 
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c 


c 

c 


I 

L 

c 


c 

c 

c 


c 

c 


c 


c 

c 

L 


C 

L 

c 

c 


define  the  BOUNDARV  mu  values  Bv  summing  the  delta  mu  values 
BNDMUl i )  -  DELTMUI 1 ) 

DO  101  I=2.NMU-1 

101  BNOMUCI)  =  BNDMU(I-l)  »  DELTMUdJ 
BNDMU(NMU)  =  1. 


define 
FMU ( 1 ) 
DO  104 
104  FMU( I ) 


THE  MU  values  at  The  QUAD  lEnIERS 
=  0 . 5*DELTMU( 1 ) 

I -2. NMU 

=  0 . 5* ( BNDMUl I  -  1  )  ♦  BNOMuil)) 


define  the  BOUNDARV  PHIS  BY  PhI  -  DPHl/2  TO  PHI  ♦  DPHI/2 

DELPHI  =  2 . 0*PI /FL0AT(NPHI  ) 

BNDPHI ( 1 )  =  0 . 5«DElPhI 

DO  102  J=2,NPhI 

102  BNDPHUJ)  =  8NDPHI(J-1)  DELPHI 


DEFINE  THE  PHI  VALUES  AT  THE  QUAD  CENTERS 


DO  103  J=1,NPHI 

103  PHl{J)  =  DELPHI ‘FLOAT ( J- 1 ) 


determine  The  solid  angle  of  The  quads 


DO  400  I=1.NMU-1 
400  OMEGA(I)  =  DELPHI 'DELTMUI I ) 

OMEGAINMU)  =  2 . 0 ' P I »D£ lTMU ( NMU ) 

WRITE(6.310) 

DO  312  1=1, NMU 

THETAC  =  ACOSI FMUII ) ) ‘RADEG 

THETAB  =  ALuSIBNDMuC I ) )»RADEG 

312  WRITE(6,314)  I . FMU ( I ) . ThE T AC . BNUMU ( 1 ) . ThE T AB . DE L TMU ( I ) , 
1  OMEGA! I ) .NRAVQDI I ) 

WRITE(6.316)  D£lPhI»RAOEG 

WRITE  header  records  FOR  OUTPUT  FILES 


REWIND  NUDU 
REWIND  NUDD 
REWIND  NUUD 
REWIND  NuUU 
WR I TE I NuOU ) 
WR I TE I NuDU ) 
WRITEINUDD) 
wR I TE( NUDD ) 
WRITE! NUUD ) 
WRI TEINUUD) 
WRITE! NUUU ) 
wR I T  E ! NUUU ) 


NUDi  ,  DOWN  uP  .NRAvQD 

IMI S : . FMI SC . FMU . PhI . BNDMU . BNDPHI .OMEGA, DEL TMU 
NUDD,  DOWN  DOWN '.NRAVQD 

I M I  SC , FMI SC , FMU . PHI  . BNDMU .BNDPHI  . OMEGA . DEL TMU 
NUUD.  UP  DOWN'. NRAVQD 

IMISC.FMISC.FMU.PHI .BNDMU .BNDPHI , OMEGA , DE L T MU 
NUUU, 'UP  UP  '.NRAVQD 

IMISC.FMISC.FMU.PHI . BNDMU .BNDPHI , OMEGA , DEL TMU 


RETURN 


FORMA  ’’S 


60  FORMAT !  IHO ,  I  1 0 .  SURFACE  REALIZATIONS  GENERATED') 

7U  FORMAT! IHO,  SukFACE  REALIZATION  FIlE  NOT  COMPATABLE  WITH  REQUESTE 
10  PARAMETERS'/'  NHEXl  =  .  I  3 . S x .  w I ND 1  =',F7,3) 

JOO  FORMATilHl,  nai.iRAl  mvDROSOl  MuDEl.  program  1'// 

1'  MONTE  carlo  air-water  SuRFAIF  rav  TRACING' ZZ 
2  THE  hexagon  grid  PARAMETERS  ‘-'UR  THIS  RUN  ARE'ZZ 
J5X,  NHE»  =  =  ORDE"  hF  TmE  wAvE  FACE"  HEXAGON' ZZ 

4SX ,  WNDSPD  =  ."T  ;  The  WIND  SPEED  IN  MZSEC  AT  12.5  M  ZZ 

55X,  USEED  =  ,IPD20.10.'  =  t^E  SEED  FOR  RANDOM  NUMBER  GENERATION') 

301  FORMAT! IHO,'  THE  QUAD  GRID  PARAMETERS  FOR  THIS  RUN  ARE'// 

ISX.'NMU  =  .13.  =  NUMBER  OF  Mu  CELLS  IN  (O.PIZ2)'Z/ 

ZSX.'NPhI  =',Ij!.'  =  NUMBER  OF  PhI  CEllS  IN  !0,2»PII'ZZ 

JSX.'NREAuO  =  .IL.  =  parameter  for  READING  THE  SFC.  REAL.  FIlE'/Z 
Asx.'NuMRAv  =  =  The  total  number  of  input  ravs  to  be  traced' 

b  ) 

j02  FORMAT!  IHO,  WA.'E  facet  PARAMETERS  ARE'ZZ 

15X,  DEL’'A  =  .  I  PE  lU  ,  3Z /5X  ,  EPS  =  '  .  E  1  0 . 3  Z  Z  5X  ,  '  S  I  G  SF  L  -  ,E10.3) 
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304  F0RMAT(1h0.'  This  is  an  initial  run  for  generating  a  file  of  capil 
ilarv  wave  surface  realizations-) 

308  FORMATIIHO.'  this  IS  A  PRODUCTION  RUN  FOR  RAY  TRACING) 

310  FORMATIIHO.-  the  MU  AND  THETA  VALUES  DEFINING  THE  QUADS  ARE'// 
15X,-I  CNT  MU  theta -, bA ,- BND  MU  THETA-.7X, 

'/■delta  mu  solid  ANGLE  NRAYQD'/) 

314  FORMATIlH  , 15 . 2(F9 .4. F9. 3 . 4X) .F9 . 4.F12. 4 , I  10) 

316  FORMATIIHO.'  THE  QUADS  HAVE  A  WIDTH  OF  DELTA  PHI  ='.F7.3, 

1'  DEGREES') 

END 


subroutine  EQSANGINMU.NPHI .OElTMU) 

ON  NHMl/EQSANG 

this  routine  PARTITIONS  THE  UNIT  SPHERE  INTO  MU  BANDS  WHICH  HAVE 

equal  solid  angles  for  all  Quads,  including  the  polar  cap.  as 
ON  PAGE  22. 

DIMENSION  OELTMU(NMu) 

c 

WRITEI6. 200) 

c 

DMU  =  FLOATINPHI ) /FL0ATINMU»NPH1  -  NPHI  ♦  1) 

00  100  I=1.NMU-1 
100  OELTMuI  I  )  =  DMU 

OELTMUlNMU)  =  OMU/FlOATINPHI ) 

RETURN 

C 

200  FORMATIIHO.'  the  UNIT  SPHERE  IS  PARTITIONED  SO  THAT  ALL  QUADS  HAVE 
1  equal  SOLID  ANGLES') 

END 


subroutine  EQThE ' . NMu . DElTMU ) 

c 

c  on  NhMI/EQTHET 

r 

C  THIS  routine  part;  TION'S  The  unit  sphere  INTO  MU  BANDS  WHICH  HAVE 

C  equal  delta  thet  1  SPACiNUi.  Plus  a  polar  cap  of  half-angle  dtheta/z, 

C  AS  on  page  24. 

c 

COMMON /CM  I  sc/  IMISCI20),fmI'>L(20) 
dimension  DElTMuinMU) 
c 

WR I TE I  6 . 200  ) 

PI2  =  0,5»FMISC(  1  ) 

C 

DTHETA  =  PI  2/ I FlOA T ( NMU )  -  U.5) 

DO  100  I=1.NMU-1 

100  OELTMuII)  =  COS' p; 2-Fl0AT(  I  ) *D7hETA )  -  COSI PI 2-FLOAT I  1  -  1 ) »DTHETA ) 

DELTMUINMU)  =  l.U  -  COSIPI2  -  F LOA T ( NMU- 1 ) ♦ DTHET A ) 

return 

C 

200  FORMATIIHO.'  THE  UNIT  SPHERE  IS  PARTITIONED  INTO  MU  BANDS  WHICH  HA 
IVE  equal  delta  theta  SPACING') 

END 
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subroutine  FINTCP( INRAV , a .B . C . pin. XI  in. SIMl , si  .  INTCP.P.UON) 

C 

C  ON  NHMl/FINTCP 

C 

C  THIS  ROUTINE  DETERMINES  IF  THE  TRACK  INTERCEPTS  A  PARTICULAR  FACET. 

C 

C  INPUT  IS 

C  INRAV  =  1  FOR  AN  INITIAL  RAV .  =  0  FOR  A  DAUGHTER  OAV 

C  A.  B.  C...THE  2-D  TRIAD  NODE  LOCATION^ 

C  PIN... The  INITIAL  POINT  OF  THE  CURRENT  TRACK 

C  XIIN...THE  DIRECTION  OF  THE  CURRENT  TRACK 

C  SIMl  AND  SI... the  distances  S(I-l)  AND  SII)  ALONG  THE  TRACK. 

C  MEASURED  FROM  PIN.  SlMl  iT.SI  BV  CONSTRUCTION. 

C 

C  OUTPUT  IS 

C  INTCP  =  0  IF  there  IS  NO  INTERCEPT 

C  1  IF  The  TRACK  DOES  INTERCEPT  ThE  FACET 

c  uON  =  the  unit  outward  normal  to  The  facet 
C  P  =  The  3-d  facet  intercept  PulNT.  if  INTCP  =  1 

C 

parameter ( MXNHEX=  7 .  MXN0DE  =  J*MxnhEX» ( MXNHEX* 1 ) ♦ 1 ) 

DIMENSION  A(2).B(2).Ct2).PIN(J).xIlN(3>.P(3). uON( 3 ) 

COMMON/ CNODES/  NNODE . FNODE ( 2 .MXNODF ) . ZNOOEIMXNODE ) 

COMMON /CM  I  SC/  IMI SC ( 20 )  . FMI SC ( 20 ) 

XIDXIH  =  FMI St ( .0 ) 

C 

C  GET  THE  NODES  ASSOCIATED  wITri  A.  B  AND  C 

C 

call  GETN0D(  A  .  NA  ) 
call  GETNODIB.  n0  ) 
call  get  nod  (  C  .  Nv.  I 

c 

I F ( ( NA . EQ . NB J  .UR,  tNA.EQ.NL)  .0".  tNB.EU.NC))  THEN 
wRITE(6.3no;  NA , A . NB , B , NC  .  C 
STOP 
ENDI  F 

DEFINE  The  FA(E;  v'ERTICES  Bv  b  i ' .  I  S 


V  1  1 

A  (  1  1 

V  1  2 

- 

A(  2  ) 

V  13 

- 

2  N  0  0  E  i  N  A  . 

V2  1 

=. 

BID 

V22 

6(2) 

v23 

2N0DE ( NB 1 

v31 

- 

Cl  1  ) 

V.3  2 

= 

C(  2) 

V33 

- 

ZNODE ( NC ) 

C 

C  GET  TmE  unit  u.'TrtrARO  TiORMAt.  bl  PA»jL  Ai 


UON  1 

^  Cv3  2 

-  4  1  2  )  •  (  V  2  3 

/ 1.1 ) 

«  /  n 

V  I  3  )  •  (  V  2  2 

'  V  1  2  ) 

UON  2 

=  (  V  3  3 

-  V 1 3 ) • ( V2 1  - 

V  1  )  1  - 

(  V  J  1 

-  ■/  1  1  )  ♦  (  v23 

-  V  1  3  ) 

UON  3 

=  C  V  3  1 

-  vll)*(v22  - 

V  12) 

V 1 2 ) • ( V2  1 

-  V  )  1  ) 

SON  = 

SIGN!  1 

.  U  .  (ON  3  )  /  SQR  T  (  UON  :  •  O' 

./N  1  ♦ 

U0N2»U0N2  V 

UON3*OON3 ) 

joni  =  sgn»uon; 

uONi!  =  SGN»oON2 
UON 3  =  SGN*uOn3 
UON ( 1 )  =  UON 1 

UON  I  2;  =  ./ONZ 
uON(J)  =  UONj 
I 

c:  GE "  s  (  u  ) .  e  i  /  T  A  jE  4.3 

so  ^  Pi'  ONI  •  ;.u'  i:’n2)i*uON2  »  i  / 13- n  i  3  ) ) 'uons  )  / 

1  1  l  I  N  (  1  1  •  I  lUN  1  »  «  1  1  N  (  2  )  •  )oN2  •  I  1  N  I  .1  )  *  UON.)  I 

(. 

C  (.HECK  FOR  FA(  F  '  IT4TE«(.EPT  Bv  bi/i  u, 

C 

I F ( S I M 1 . lT , S0» x I DX I M  AND.  SU’xIDXIh  lE  si)  THEN 

C 

C  HAVE  A  FA(.  ET  intercept 

C 

C  (HECK  INIMAl  RAvS  to  see  if  The  RAV  IS  CUMING  IN  UNDER  THE  GRID 

C 
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lOK  =  1 

I F ( INRAV . EO . n  Then 

XPDOTN  =  XHN(  1  ) ‘UONt  1  )  •>  XI  INI  2  J  •UONl  )  ♦  X1  ini  3  )  ♦U0N(  3) 
1F(XIIN(3)  .LE.0.0  .and.  XPOOTN.GT.0.0)  IOK  =  0 
I F ( XI IN( 3  )  . Gi . 0 . 0  .AND.  XPDOT N . L T . 0 . 0 )  lOK  =  0 
ENDI  F 
C 

I F ( IOK . EQ . 1 )  THEN 
C  FACET  INTERCEPT  IS  OK 

InTCP  =  1 

P(l)  =  PIN(l)  -  S0*XI1N(1) 

P{2)  =  PIN(2)  ♦  SQ*XI IN( 2) 

P(3)  =  PINO)  »  SQ*XIIn(3) 

ELSE 

C  RAV  IS  UNDER  the  GRID.  LET  IT  PASS  THROUGH  THE  SURFACE  UNDETECTED 

INTCP  -  0 
ENDI  F 

C 

ELSE 

InTCP  -  0 
ENDI  F 

(. 

RETURN 

C 

300  FORMAT! IhO,'  SUB  FINTCP;  iLL-UEFiNtU  FACEI'// 

IIOX.’NODE.  a  =  ■  .  • S .  1P2E  12 . 3/ /  lOx .  NOOE .  B  -  .  I  5 . 2E  1  2 . 3 / / 

2  lOX  ,  ■  NOOE  .  C  -  .  :  .  2E  12 . 3  ) 

END 


(, 

C 

c 

c 

C 

c 

c 

c 


c 

c 

L 


SiiBRO,.’- iNt  Ofc'Ah  I  V  T  I  p;  .  vTI  P.  .  K,  1  H  Sl  .  A.B.C) 
ON  NhMI  •  .jF'aB! 


gIvEn  r ao  twi4[,  inie Rcfpr  points 
values.  KSi  AND  FSi.  This  routine 

notation  USF.D;  TjK  =  VJIK) 


''TIPI  AND  VTIP2.  AND  THEIR  K 

returns  The  triad  vertices  a.  B 


dimension  v’IP; 

lOVMON/ ChExGn / 
COMMON/ CMI SC /  i 


.vriP2i2).A(2).B(2).C(2i 

'Ex.Rll.RlV.Ril.R/V.RKHATlM)  RIRAT 

:  SC ( 2o; . FMi sc i 2u  > 


DELTA  =  FMI  St  <  l-i  ; 
EPS  =  FMI SC ;  1  7  ) 


if(ks;'ks2.eg.  ■  Then 


hA»£  .ASE  R1  P*  see  bJ/FIouPE  7|,  .,SE  J  1  /  J  .  B  O  .  1  2 


IFIifSI.Eu  li 

I  -'t 

'"'IP:.  » 

Ml  ^ 

y '  ip:  !  :  . 

/I?  - 

/  *  I  P  1  2  , 

M'  1  - 

y  T  I  p  2  1  1  ) 

¥?^  ^ 
El  iE 

V  T I P2 ( 2 i 

M  I  ^ 

y  T I  p  2  ,  V 

V  n  - 

V  y  I  P  2  (  I  1 

V  1  2  = 

V  T  I  P  2  :  2  i 

1  = 

Y  T  I  p  1  (  1  , 

i'll  -= 
fcNOl  f- 

VT I P 1 ( 2 ) 

AND  C 
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c 

01  =  '^11‘RIRAT  «■  Y12 
02  =  -V21*R1RAT  +  V22 

r 

A1  =  0. 25*(02-Dl)*DELTA/EPS 
A2  =  0.5»(01->-02) 

A  (  1  )  =  A  1 
A(2)  =  A2 
C 

SGNl  =  SIGNd.O,  (yil-Al)*Rll  ^  { V12-A2)»R12J 
SGN2  =  SIGN(1.0.  (V21-A1)»R21  (  V  2  2  -  A  2  ) ‘R  2  2  ) 

C 

B(l)  =  A1  ♦  SGN1»0ELTA*0.E. 

8(2)  =  A2  +  SGN1*EPS 

C(l)  =  A1  -  SGN2*0ElTA»0 . 5 

C(2)  =  A2  +  SGN2*EPS 

c 

ElSEIF( KS1+KS2 . EC . ! )  THEN 
L 

C  HAVE  CASE  I-Rl  (SEE  63/FIGURE  8).  USE  63/3.13 

C 

IF(ksi.E0,0)  Then 

c 

C  VO  I S  VT I  PI .  V 1  I S  VT I P2 

YOl  =  YTIPl(l) 
y02  =  YTIP1(2) 

Yll  -  YTIP2(1) 
y 12  =  YT 1 P2 ( 2 ) 

else 

L 

C  Yf)  I  s  YT  I  P2  .  Y  1  I  S  VTI  P  1 

YOl  =  YT I P2 (  1  ) 

Y02  =  VTIP2(2) 

Yll  =  VTIPK  1) 

Y  12  =  YT I P  1  ( 2 ) 

EnOI  F 

C 

A1  -  0.5*(Y02  -  fll'RlRAT  -  V  1 2 ) • OEl T A / EPS 
A  (  1 )  =  A  1 

A( 2)  =  V02 

c 

SGNl  =  SIGN(1.0,  (y11-a1)*R11  •*  (  Y  1 2  -  VO  2  )  *  R  1 2  ) 

C 

B(l)  =  A1  »  SGN1*0ELTA»0.5 
8(2)  =  Y02  ♦  SGN1*EPS 

C(l)  =  A1  SIGN(1.0.  YOl  -  A1)*0ELTA 
C(2)  =  Y02 
C 

EL SE I F ( KS 1 ♦K S2 . EG . 2 )  THEN 

HAVE  CASE  I-R2  (SEE  eS/FIGCVg  Bj.  uSE  bJ/3.14 

;  F ( KS  1  . EQ . 0)  Then 

C 

C  YO  IS  VTIPl,  V2  IS  yTlP2 

YOl  =  yTIPK  1  ■' 

Y02  ^  y  T I P 1 ( 2  / 

7  2  1  =  V  T I P  2 (  1 

y2.  -  VTIP212) 

ELiE 

C 

c  YO  IS  YTIP2,  ■/  IF  VTIPl 

YOl  =  y  T I P2 (  1  , 
v02  =  yriP2!2,' 
v21  =  yTlPl(l) 

722  =  yTIPll2) 

ENOI  F 

;  Q  5.(-v21*R’RAT  ♦  V22  -  Y0  2')*DEiIA/EPS 
A  (  1  1  -  A  1 

A ( 2 )  =  202 

C 

SGN2  =  SI  ON (Y2l-A1)»R21  »  (y22-yU2l»R22) 

C 
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B(l)  -  A1  -  SGN2»DElTA*0 , b 
0(2)  =  V02  -f  SGN2*EPS 

C(l)  =  A1  SIGNd.O,  YOl  -  A1)*0ElTA 
C(2)  =  V02 
C 

else 

C 

C  ERROR  IN  INPUT 

WRITE(6,100)  VTI PI , VTI P2 . KSl , KS2 
STOP 
ENDI  F 
RETURN 
C 

lOU  F0RMAT(1H0,’  ERROR  IN  SUB  GETABL  //IH  .  VTIPl  = ' . 1 P2E 1 2 . 3 , 4X . 
l'yTIP2  =  ■  ,  2E  12 , 3 . ,  K(  1  )  ,  K(2)  =^'.213) 

END 


subroutine  GETr*c::(A,  node) 

On  NMMI/GETNOO 

GIVEN  A  VECTOR  A,  WHICH  LOCATES  ANY  POINT  IN  THE  HEXAGON,  THIS 
routine  returns  the  index,  node,  of  the  nearest  TRIAD  NODE. 

PARAMETER(MXNhEX=  7  ,  MXN0DE  =  3»MXNHEX»  (  MXNHEX-f  1 ) -H  ) 
COMMON/CHEXGR/  NHEX 

COMMON /CNODES/  NNODES . FNODE ( 2 .MXNODE) 

COMMON / CM 1  SC/  IMI SC( 20)  ,FMISC(20) 

DIMENSION  A(2) 
delta  =  FMISC(16) 

EPS  =  FMI SC (  17  ) 

CHECK  Y  values  OF  THE  LEFT  HEXAGON  BOUNDARY  POINTS 

AY  =  A(2)  -  0.5*EPS 
K  =  1 

I F ( FNODE ( 2 . K) . GT . AY )  GO  TO  100 
DO  200  J= 1  , NHEX’  1 
K  =  K  NHEX  +  j 

I F ( FNODE I  2 . K )  . OT  , AY )  GO  TO  luO 
200  CONTINUE 

DO  202  j-NHEX,2,-l 
K  =  K  +  NHEX  ♦ 

I F ( FNODE ( 2 , K ) . o’ . AY )  GO  TO  100 
202  CONTINUE 

NOW  CHECK  X  VAlUES  along  CON^iTANI  V  ROW 

100  AX  =  A (  1  )  -  0  .  ■  'DEL  T A 

DO  204  J  =  K.NN0L'iS 

I  F  (  FNODE  (  1  ,  .j  )  .  r.T  .  AX  )  GO  10  102 

204  CONTINUE 
C 

WRITE(6,206)  A 
STOP 
C 

102  NODE  =  J 
RETUR.N 
C 

20b  FORMATIIHU,  SUB  GETNOD:  POINT  A  =  (  .  1 PE  1  2 . 3 ,  ’  .  '  , E 1 2 . 3 , 

1)  not  within  hexagon  ) 

END 
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SUBROUTINE  MPINDX FMU, PHI . I , J) 

ON  NHMl/MPINDX 

GIVEN  A  (MU, PHI)  POINT,  THIS  ROUTINE  RETURNS  THE  INDICES  (I,J) 
OF  THE  QUAD  QIJ  WHICH  CONTAINS  THE  POINT. 

-1.0  .LE.  FMU  .LE.  1.0  AND  0.0  . LE .  PHI  . LE .  2*PI 

PARAMETER  (MXMU=10,  MXPHI=24) 

COMMON/CMI SC/  IMISC(20) 

COMMON/CMUPHl /  0NDMU(MXMU) . BNDPHI (MXPHI ) 

NMU  =  IMISC(l) 

NPHI  =  IMISC(2) 

ABSMU  =  ABS(FMU) 

SEARCH  THE  MU  BOUNDARY  VALUES 

DO  400  IB=1,NMU 

IF(ABSMU.LE.BNDMU( IB) )  GO  TO  402 
400  CONTINUE 
402  I  =  IB 

SEARCH  THE  PhI  BOUNDARY  VALUES 

DO  404  JB-1,NPHI 
I F (PHI . lT .BNDPHI ( JB) )  GO  TO  40b 
404  CONTINUE 
JB  =  1 

406  J  =  JB 

RETURN 

END 


SUBROUTINE  P2ARAY(A.NR,NC,IDIM. lOFMT .TITLE) 

L 

C  This  routine  prints  out  an  array  a  of  nr  rows  and  NC  columns  ON  ANY 

C  OF  A  number  of  FORMATS.  IDIM  IS  THE  ROW  DIMENSION  OF  A  IN  THE 

C  CALLING  PROGRAM,  THE  VALUE  OF  IDFMT  SPECIFIES  THE  FORMAT: 

C 

C  IDFMT 

C 
C 
C 
C 
C 
C 
C 

C  THE  ARRAY  IS  PARTITIONED  BY  COLUMNS  INTO  BLOCKS,  AND  ROWS  AND 

C  COLUMNS  ARE  NUMBERED.  THE  CHARACTER  STRING  TITLE  CONTAINS  ANY 

C  DESIRED  title  (UP  TO  130  CHARACTERS  FOR  PRINTER  OUTPUT) 

C 

DIMENSION  A( IDIM.NC) 

CHARACTER  TITLE»(*) 


=  1  FOR  10F12.4 

2  FOR  1P10E12.4 

3  FOR  1GI12 

4  FOR  12A10 

5  FOR  1P6E20.8 

6  FOR  20F5 .  1 

7  FOR  1P5E25  .  15 
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SET  UP  the  proper  FORMATS, 

KSIZE  =  10 
ASSIGN  910  TO  IFMTl 
IF( IDFMT . EQ. 1)  THEN 
ASSIGN  11  TO  1FMT2 
ELSEIF( IDFMT . EQ. 2)  THEN 
ASSIGN  21  TO  IFMT2 
ElSEIF(IDFMT.EQ.3)  then 
ASSIGN  31  TO  IFMT2 
ELSEI F ( I DFMT . EQ . 4)  THEN 
KSIZE  =  12 
ASSIGN  912  TO  IFMTl 
ASSIGN  41  TO  IFMT2 
ELSEIF ( IDFMT . EQ . 5)  THEN 
KSIZE=  6 

ASSIGN  906  TO  IFMTl 
ASSIGN  51  TO  IFMT2 
ELSEIF ( IDFMT , EQ. 6)  THEN 
KSIZE  =  20 
ASSIGN  920  TO  IFMTl 
ASSIGN  61  TO  IFMT2 
ELSEI F ( IDFMT . EQ . 7 )  THEN 
KSIZE  =  5 

ASSIGN  905  TO  IFMTl 
ASSIGN  71  TO  IFMT2 

else 

WRITE(6. 100)  IDFMT 

RETURN 

ENDIF 

PARTITION  ARRAY 

KMANV  =  ( ( (NC- 1 ) /KSI ZE)  t  1)*KSIZE 
ie,.ocK  =  0 
N8L0CK  =  1 

IF(NR.l£.25I  NBLOCK  =  60/(NR»4) 

PRINT  ARRAY 

DO  210  L=KS1 ZE , KMANY , KSIZE 
Ll  =  L  -  (KSIZE  -  1) 

l2  =  L 

IF { L . GE . KMANY )  l2  =  NC 
DO  210  I = 1 . NR 

I F (MOD( I  -  1 .50  )  . NE . 0)  GO  TO  210 

I F ( IBLOCK . EO. 0  . OR .  I  block .GE . NBlOCk)  THEN 

PRINT  TITLE  AND  COLUMN  HEADINGS  IF  NEW  PAGE 

IBLOCK  =  1 

WRIT£(6. 110)  TI'lE 

WR  I  TE( 6 , I FMT  1  )  :K,K  =  L1.l2) 

else 

PRINT  column  HEADINGS  FOR  A  NEW  BLOCK 
IBLOCK  =  IBLOCK  +  1 

WRITE(6, IFMTl)  (K,K=L1,L2) 

ENOI  F 

WRITE  A  line  OF  UAIA 
210  WR I TE I  6 .  I FMT2 )  I  .  C A ( I  . J )  . J - L  1  . 1  2 ) 

RETURN 

FORMATS 

IFMTl  FOR  COLUMN  LABELS 
aU5  FORMAT(1h  //10t.lI25) 

906  FORMAT(1m  //1Qx,uI20) 

910  FORMAT!  IH  //lOX.  10112) 

912  FORMAT(1m  //10a, 12110) 

920  FORMAT!  IH  //10X,;rjI5) 
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n 

21 

31 

41 

51 

61 

71 


IFMT2  FOR  DATA 


F0RMAT(1H  ,I9,10F12.4) 
F0RMAT(1H  . 19 ,  IPlOE  12 . 3) 
FORMATdH  .19.10112) 
FORMAT ( IH  .  19 . 12A  10) 
FORMAT(1h  , 19. 1P6E20.8) 
FORMATdH  .19,20F5.1) 
F0RMAT(1H  , 19 . 1P5E25 .  15) 


100  FORMATdHO.  ■  invalid  FORMAT  OPTION  iN  P2AfiAV  I DFMT 
110  F0RMAT( IHl.A) 

END 


=  '  .  15) 


SUBROUTINE  P3ARAY( A . NR , NC , NP . I D I M , JD I M . I DFMT, TITLE) 

THIS  routine  prints  out  an  ARRAV  a  of  nr  rows.  NC  COLUMNS  AND 
NP  PLANES  ON  ANY  OF  A  NUMBER  OF  FORMATS.  IDIM  AND  JDIM  ARE  THE 
ROW  AND  COLUMN  DIMENSIONS  OF  A  IN  THE  CALLING  PROGRAM.  THE  VALUE 
OF  IDFMT  SPECIFIES  THE  FORMAT; 


C 

C 

C 


IDFMT 


1 

FOR 

lOF  12 . 4 

2 

FOR 

1P10E12 . 4 

3 

FOR 

10112 

4 

FOR 

12A  10 

5 

FOR 

1P6E20 . 8 

6 

FOR 

20F5  .  1 

7 

FOR 

1P5E25  .  15 

THE  ARRAY  IS  PRINTED  BY  PLANES.  FOR  EACH  PLANE 
THE  ARRAY  IS  PARTITIONED  BY  COLUMNS  INTO  BLOCKS,  AND  ROWS  AND 
COLUMNS  ARE  NUMBERED.  THE  CHARACTER  STRING  TITLE  CONTAINS  ANY 
DESIRED  title  (UP  TO  130  CHARACTERS  FOR  PRINTER  OUTPUT). 


DIMENSION  A ( IDIM . JDIM . NP ) 
CHARACTER  TITlE*(*) 


SET  UP  THE  PROPER  FORMATS 


KSIZE  =  10 
ASSIGN  910  TO  IFMTl 
I F (I DFMT . EQ . 1 )  then 
ASSIGN  11  TO  IFMT2 
else  IF ( IDFMT . EQ .  2 1  THEN 
ASSIGN  21  TO  IFMT2 
ElSEI F (IDFMT . EQ . 3)  THEN 
ASSIGN  31  TO  IFMT2 
ELSEI F ( IDFMT . Eu . 4 )  THEN 
kSIZE  -  12 
ASSIGN  912  TO  IFMTl 
ASSIGN  41  TO  IFMT2 
EL SEI F ( I DFMT . EQ . 5 )  THEN 
KSIZE^  6 

ASSIGN  906  TO  IFMTl 
ASSIGN  51  TO  IFMT2 
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ELSEIF t IDFMT , EQ. 6)  TmEN 
KSIZE  =  20 
assign  920  TO  IFMTl 
ASSIGN  61  TO  IFMT2 
ELSEIF( IDFMT . EQ  .  7 )  THEN 
KSIZE  =  5 

assign  905  TO  IFMTl 
assign  71  TO  IFMT2 
ELSE 

WR1TE(6,100)  IDFMT 
RETURN 
ENDIF 

PARTITION  ARRAY 

KMANY  =  (  C (NC- 1  ) /KSIZE)  »  1)»KSIZE 
IBLOCK  =  0 
N8L0CK  =  1 

IF{NR.LE.25)  NBLOCK  =  60/(NR-*4) 

PRINT  ARRAY 

DO  210  IP=1.NP 

DO  210  L=KSI ZE , KMANY . KSI ZE 
LI  =  L  -  (KSIZE  -  1) 

L2  =  L 

IF(L.GE. KMANY)  l2  =  NC 
DO  210  1^1. NR 

IF(M0D( I- 1 .50)  . NE , 0  )  GO  TO  210 

IF( IBLOCK . EQ . 0  .OR. IBLOCK. GE. NBLOCK)  THEN 

PRINT  TITLE  AND  COLUMN  HEADINGS  IF  NEW  PAGE 
IBLOCK  =  1 

WRI T6( 6 , 1  10  )  title  ,  I  P 
WRITE(6, IFMT  1)  (K.K  =  l1.L2) 

ELSE 

PRINT  COLUMN  HEADINGS  FOR  A  NEW  BLOCK 
IBLOCK  =  IBLOCK  +  1 
WRI  TE(6  ,  I  FMT  1 )  {K.K=:L1,l2) 

ENDI  F 

C  WRITE  A  LINE  OF  DATA 

210  WRITE(6, 1FMT2)  I . C A ( I , J . I P ) . J=L 1 , l2 ) 

C 

RETURN 

C 

C  FORMATS 

C 

C  IFMTl  FOR  column  LABELS 

905  F0RMAT(1H  //lOK.SIZS) 

906  F0RMAT(1H  //10X.6I20) 

910  FORMAT(ih  //lOX,  10112) 

912  F0RMAT(1H  //lOX.  12110) 

920  F0RMAT{1H  //10X.20I5) 

C 

C  1FMT2  FOR  DATA 

1  1  FORMAT  (  IH  .  19  ,  1C"=  12  .  d  ) 

21  F0RMAT(1H  , 19 , IPlOE 12 . 3 ) 

3 1  FORMAT) IH  .19.10112) 

4  I  FORMAT)  IH  .19,  12A 10 ) 

51  FORMAT!  IH  . 19 .  1P6E20 . 8  ) 

61  F0RMAT(1H  ,I9.2GF5.1) 

71  F0RMAT(1H  .  19 .  1P5E25 .  15 ) 

C 

100  FORMAT(1HO,1NVAi1D  format  option  IN  P2ARAY,  IDFMT  ='.15) 

110  FORMAT )  IH  1  , A //  '  THREE-DIMENSIONAL  ARRAY,  PLANE  (THIRD  INDEX)'  13) 
END 
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subroutine  PULLCR.P.XI) 

ON  NHMI/PULL 

THE  ROUTINE  PULLS  R.  P  AND  XI  OFF  OF  THE  BOTTOM  OF  THE  STACK 
AS  DESCRIBED  IN  63/PAGE  11. 

parameter  (MXSTAK=10) 

COMMON  /CSTACK/  NST ACK . STACK ( MXSTAK . 7 ) 

DIMENSION  P{ 3) .XI ( 3) 

GET  THE  BOTTOM  ELEMENTS 

R  =  STACK(NSTACK . 1) 

DO  200  1=1.3 

P(I)  =  STACK(NSTACK  .  l-t- 1 ) 

200  XKI)  =  STACK(NSTACK.  I»4) 

NSTACK  =NSTACK  -  1 

C 

RETURN 

END 


subroutine  PUSH(R.P.XI) 

c 

C  ON  NHMI/PUSM 

c 

C  THIS  ROUTINE  PUSHES  R.  P  AND  XI  ONTO  THE  BOTTOM  OF  THE  STACK 

C  AS  DESCRIBED  IN  63/PAGE  11. 

C 

parameter  (MXSTAK=10) 

COMMON  /CSTACK/  NSTACK . STACK(MXSTAK . 7 ) 

DIMENSION  P(3) .XI (3) 

C 

C  TEST  FOR  overflow  OF  STACK 

C 

IF(NSTACK.GE. MXSTAK)  THEN 
WRIT£(6.100)  NSTACK 
RETURN 
ENDI  F 

C 

C  ADD  NEW  ELEMENTS  AT  THE  BOTTOM 

C 

NSTACK  =  NSTACK  +  1 

STACK ( NSTACK . 1 J  =  R 
DO  200  1=1.3 

stack! NSTACK .  1+  1  I  =  P(  1  » 

200  STACK(NSTACk, 1+4)  =  XI(I) 

RETURN 

100  FORMAT!  IHO.'  STACK  FULL.  NSTAC.K  -  ,  H)  .  '  RAV  DISCARDED  ) 

END 
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FUNCTION  REFLF(THETAP. theta) 

ON  NHMl/REFLF 

THIS  FUNCTION  RETURNS  THE  REFLECTANCE.  GIVEN  THE  REFLECTED  AND 
REFRACTED  ANGLES,  THETA  PRIME  AND  THETA 

COMMON/CMISC/  IMISC(20) .FMISC(20) 

DATA  EPSO/l.OE-5/ 

PI  =  FMISC(l) 

REFR  =  FMISCCia) 

TPMT  =  THETAP  -  ThETA 
TPPT  =  THETAP  +  ThETA 

CHECK  FOR  NORMAL  INCIDENCE 

lOK  =  0 

I F ( ABS( TPMT) . GT . EPSO  .AND.  ABS ( TPMT -P I ) . GT . EPSO )  lOK  =  lOK  ♦  1 
IF(ABS(TPPT) .GT.EPSO  .AND.  AB S ( T PPT -P I ) . GT . EPSO )  lOK  =  lOK  +  1 
IF(I0K.EQ.2)  Then 
63/3 . 20 

REFLF  =  0 . 5* (  ( SI N ( TPMT )  /s I N(TPPT ) ) » *2  *  ( T AN { T PMT ) / T AN ( TPPT )  ) • *  2 ) 
ELSE 

USE  limiting  CASE  FOR  NORMAL  INCIDENCE 
REFlF  =  ((REFR  -  !  0)/(REFR  ♦  1.0))«*2 

ENDIF 
C 

RETURN 

END 


SUBROUTINE  R S P l  1 T ( R I N , X 11 N . UON .  RRE F L , X  I  REF L , RR E F R , X  I R E FR ) 

C 

C  NHMl/RSPLIT 

C 

C  THIS  routine  determines  ThE  REFLECTED  AND  REFRACTED  DIRECTIONS 

C  AND  THE  ASSOCIA'tD  RADIANCES  AT  THE  INTERCEPTED  FACET. 

C 

C  factors  of  REFR**2  AND  1/REFR»»2  ARE  NOT  INCLUDED  IN  THE 

c  transmitted  radiances 

C 

C  INPUT 

C  R IN... THE  RADIANCE  OF  THE  INCOMING  RAV 

C  XIIN...THE  DIRECTION  OF  THE  INCOMING  RAY 

C  UON . . . THE  UNIT  OUTWARD  NORMAL  OF  THE  INTERSECTED  FACET 

C 

C  OUTPUT 

C  RREFL. 

C  XIREFl 

C  RREFR. 

C  XIREFR 

C 

DIMENSION  XIIN(3J,U0N(3),XIREFl(:1),XIREFR(3) 

COMMON /CM  I  SC/  I  MI  SC ( 20 )  . FMI SC ( 20 ) 


...THE  RADIANCE  OF  THE  REFLECTED  RAY 
.  .  .THE  DIRECTION  ' 

...The  radiance  refracted 

.  , . the  direction  ' 
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REFR  =  FMISC(18) 

XPOOTN  =  Al  IN(  1  )  ♦UON{  1  )  XI  1N(  2  I  •UON(  2  )  ♦  X  1  I  N  (  3  J ‘UON  (  3  ) 

if(xpdotn.lt.o.o)  then 
air-incident  case 

reflected  and  refracted  direction  av  b3/3.18 

c  =  XPDOTN  +  SORT  I XPDOTN*XPOOTN  »  REFR'REFR- 1 . 0 ) 

DO  100  J=1.3 

XIREFL(J)  =  XIIN(J)  -  2 . Q»APOOTN»UONC J ) 

100  XIREFRCJ)  =  (XIIN(J)  -  C»UON( J ) ) /REFR 

angles  8V  63/3 . 18 

TMETAP  =  AC0S( ABS(XPDOTN) ) 

THETA  =  ASIN(SIN(THETAP)/REFR) 

R  =  REFlF(THETAP,TMETA) 

COMPUTE  RADIANCES  BV  63/3.30  AND  3.31A 
RREFL  =  RIN»R 
RREFR  =  RIN»tl.O-R) 


WATER-INCIDENT  CASE 

reflected  AND  refracted  DIRECTIONS  BV  63/3.19 

ARG  =  (REFR»XPD0TN)**2  -  REFR«REFR  •'  1.0 

IF(AfiG.G£.0.0)  then 
C  =  REFR»XPD0TN  -  SORT(ARG) 

else 

C  =  0 . 0 
ENDIF 

DO  102  J=l,3 

XIR£FL(J)  =  XIIN(J)  -  2.0*XPDOTN*UON( JI 
102  XIR£FR(J)  =  REFR»X1IN(J)  -  C*U0N(J) 

angles  B/  63/3 .  19 

THETAP  =  ACOS( ABS(XPDOTN)  ) 

Compute  the  reflEotance 

IF(THETAP.GT.RAD48)  then 

HAVE  total  internal  REFLECTION 

R  -  1.0 

ELSE 

reflection  and  REFRACTION 
theta  =  ASIN(REFR*SIN(THETAP) ) 

R  =  REFLFITHETAP. THETA) 

ENDIF 

radiances  BV  63/3.30  AND  3.31B 

RREFL  =RIN*R 

RREFR  =  RIN* I  1 • 0  -  R ) 


RETURN 
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subroutine  T I P( P . XI , 1 al^ j 

c 

c  ON  NHMl/TIP 

C 

C  GIVEN  A  POINT  P  AND  A  DIRECTION  XI.  TmIS  ROUTINE  FIRST  COMPUTES 

C  THE  TRACK  OF  THE  RAY  P  +  S»XI  AS  IN  63/SECTION  3B . 

C  IF  lALL  =  0,  THE  COMPUTATIONS  ARE  CARRIED  ONLY  TO  63/3.6,  AND 

C  SMIN  IS  RETURNED. 

C  IF  lALL  =  1,  THE  TRIAD  INTERCEPT  POINTS  YTIP  ARE  ALSO  COMPUTED. 

C 

PARAMETER (MXNHEX= 7 ,  MXNT I P=4 ‘MKHnEX^ 1 ) 

DIMENSION  P(3I .XI (3) 

DIMENSION  SO ( -MXNHEX : MXNHEX ) . S 1 ( -MXNHEX : MXNHEX ) , S2 ( -MXNHEX : MXNHEX) 
DIMENSION  IR(MXNTIP) . WORK ( MXNT 1 P ) . KWORK ( MXNT I P ) 

COMMON /CHEXGR/  NMEX ,R1(2) .R2(2I .RlHATl .R1HAT2. R2HAT 1 , R2HAT2 
COMMON /CT I P/  NTIP . SMI N . YT I P ( 2 . MXNT I P ) . S(MXNTIP) . KS(MXNTIP) 

COMMON/ CM! SC/  I  MI  SC ( 20 ) . FM I  SC ( 20 ) 

C 

DATA  EPSDOT/ 1  . OE-8/ 

C 

EPS  =  FMISC( 17) 

C 

C  COMPUTE  the  horizontal  UNIT  VECTOR.  XlH.  AND  XI  COT  XIH 

FMISC(20)  =  SQRT(XI (  1 ) ‘XI (  1  )  ♦  xl(2)*xl(2)) 

XlHl  =  XI ( 1) /FMI SC( 20) 

XIH2  =  XI ( 2) /FMI SC( 20) 

PI  =  P( 1 ) 

P2  =  P(2) 

DO  100  L=-NHEX,NHex 
SO(L)  =  1.E30 
S1(L)  =  1.E30 
100  S2(L)  =  1.E30 
C 

C  COMPUTE  SO  values  BY  63/3.6 

C 

IF( ABS(XIH2 ). GT , EPSDOT )  THEN 
SS  =  -P2/XIH2 
A  =  EPS/XIH2 
DO  110  L=-NhEX,Nh£X 
110  SO(L)  =  SS  float  IL)*A 
ENDIF 

C 

C  COMPUTE  SI  BY  63/3.5 

C 

D  -  XIH1*R1HAT1  XIh2*R1HAT2 
IF{ABS(0) .GT , EPSDOT)  THEN 
SS  =  -(Pl'RlHATl  P2»R1HAT2)/D 
A  =  2 . 0»EPS*R  1HAT2/0 
DO  112  l=-nhex.nhex 
112  S1(L)  =  SS  FlOATCL)*A 
ENDIF 
C 

C  COMPUTE  S2  BY  6J/3.5 

C 

IF ( ABSIXIHI) .GT  EPSDOT)  THEN 
O  =  XIH1»RZHAT:  ^  XIH2*R2HAT2 
I  F (ABS(D )  .GT . EPSDOT )  THEN 
SS  =  -(P1*R2HAT1  +  P2»R2HAT2)/D 
A  =  2 . 0*EPS*R2MAT2/D 
DO  114  L=-NHEX.NHEX 
114  S2(L)  =  SS  ♦  FlOAT(lJ*A 

ENDIF 
ENDIF 

C 

C  find  THE  MINIMUM  POSITIVE  END  POINT  BY  63/3.6 

C 

SMIN  =  AMI N 1 ( AMAX 1 ( S0( -NHEX) . SO( NHEX) ) .  AMAX 1 ( S 1 ( -NHEX ) , S 1 ( NHEX ) ) , 
1  AMAX 1 ( SZ( -NHEX) . S2(NHEX )) ) 

1  F ( I  all . EQ . 0 )  RETURN 
C 

C  SELECT  THE  NON-NEGATIVE  S  VALUES  . LE .  SMIN 

C 
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NS  =  0 

DO  200  L=-NHEX.NHEX 

IF ( S0(L) .GT , -EPSDOT  .and.  SO ( l ) . L T . SMI N» EPSDOT )  THEN 
NS  =  NS  +  1 
S(NS)  =  S0(L) 

KS(NS)  =  0 
ENDIF 
C 

IF(SI{L) .GT . -EPSDOT  .AND.  S 1 ( L ). L T . SM I Nf EPSDOT )  THEN 
NS  =  NS  +  1 
SINS)  =  Sl(L) 

KS(NS)  =  1 
ENDIF 
C 

IF  (  S2(  L)  .  GT  . -EPSDOT  .AND.  S2  (  L)  .  L  T  .  SMI  N-f  EPSDOT  )  THEN 
NS  =  NS  +  1 
SINS)  =  S2a) 

KS(NS)  =  2 
ENDIF 

200  CONTINUE 

ORDER  the  S  values 

DO  210  1=1, NS 
210  IR( I  )  =  I 

CALL  VSRTRIS.NS. IR ) 

CORRESPONDINGLY  PERMUTE  THE  ASSOCIATED  K  VALUES 

DO  212  1=1, NS 
212  KWORKI I )  =  KS( I  ) 

00  214  1=1, NS 
214  KS(  I  )  =  KWORKI IR(  I  )  ) 

C 

C  CHECK  the  SORTED  S  VALUES  FOR  EQUAL  ENTRIES.  DISCARD  DEGENERATE 

C  values  and  relabel  the  remaining  S  value  WITH  AN  APPROPRIATE  KS  VALUE. 

C 

DO  240  1=1, NS 
WORKI I  )  =  SI  I  ) 

240  KWORKC I )  =  kSI  I  ) 

NTIP  =  1 

I F I  St  1  )  . LT . 0 . 0  )  Sill  =  0.0 
C 

DO  260  1=2. NS 

IF  I A8 SI  WORK  I  I  )  -WORK ( I  -  1 ) )  . GT . EPSUOT )  THEN 
NTIP  =  NTIP  1 
S(NTIP)  =  WORKi I ) 

KS(NTIP)  =  KWORKI  I  ) 

C 

Else 

C  multiple  S  values  found,  relabel  KS 

IF(ABSIXIHl) .GT , EPSDOT)  THEN 

KSINTIP)  =  0 

ELSE 

KSINTIP)  =  1 

ENDIF 

ENDIF 

250  continue 
C 

C  COMPUTE  the  TRIAD  INTERCEPT  POINTS  FROM  THE  NON-DEGENERATE  S  VALUES 

C  USING  63/3 . 7 

C 

DO  300  I  =  1 , NT  I P 
VTIPIl.I)  =  PI  =  StI) *X IHl 
300  VTIPt2.I)  =  P2  *•  SII)»XIH2 
C 

RETURN 

C 

END 
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subroutine  trace ( INRAV . R1 N , pin . XI  in .  lOUT . P , RREFL . XIREFL , RREFR , 

1  XIREFR) 

ON  NHMI/TRACE 

GIVEN  AN  INITIAL  RADIANCE,  RIN,  STARTING  POINT.  PIN,  AND 
DIPEC'^’ON,  XIIN,  ’^HIS  ROUTINE  TRACES  THE  RAV  UNTIL  IT  EITHER 
leaves  the  HEXAGON  REGION  OR  INTERCEPTS  A  FACET. 

IF  THE  RAV  leaves  THE  HEXAGON  BEFORE  INTERSECTING  A  FACET. 
lOUT  =  1  AND  RETURN  IS  MADE. 

IF  THE  RAV  INTERCEPTS  A  FACET  BEFORE  LEAVING  THE  HEXAGON. 
lOUT  =  0  AND 
P  =  THE  INTERCEPT  POINT 
RREFL  =  THE  REFLECTED  RADIANCE 
XIREFL  =  THE  DIRECTION  OF  ThE  REFLECTED  RAV 
RREFR  =  THE  REFRACTED  RADIANCE 
XIREFR  =  THE  DIRECTION  OF  THE  REFRACTED  RAV 
ARE  RETURNED. 

PARAMETER(MXNHEX=7 .  MXNTIP=4»MXNHEX+1) 

COMMON /CT IP/  NTIP, SM I N . V T I P ( 2 . MXNT I P ) .SIMXNTIP) .KS(MXNTIP) .ZMIN. 

1  ZMAX 

DIMENSION  PIN(3),XIIN(3),P(3).XIREFL(3).XIREFR(3) 

DIMENSION  A(2) ,B( 2) ,C(2) ,UON(3) 

compute  the  triad  intercept  points  FOR  THE  RAV 

call  TIP(PIN,XIIN,  1) 

locate  THE  TRIAD  INDICES  FOR  WHICH  AN  INTERCEPT  IS  POSSIBLE 
I F (XI IN( 3) . LE . U . 0 )  THEN 
DOWNWARD  RAV 

TANTHP  =  TAN(ACOS(-XriN(3))) 

GET  FIRST  FACET  TO  BE  CHECKED 
IF(PIN(3) .GT .ZMAX)  THEN 

initial  POINT  ABOVE  THE  MAXIMUM  SURFACE  (INITIAL  RAV) 

D1  =  (PIN(3)  -  ZMAX)»TANTHP 

00  50  1=2. NTIP 
IF ( S( I  )  .GE . D1 )  GO  TO  55 
50  CONTINUE 
5511=1 

ELSE 

INITIAL  POINT  BElOW  THE  MAXIMUM  SURFACE  (DAUGHTER  RAV  OR  LOW-ANGLE 
INITIAL  RAV) 

11  =  2 
ENDIF 

GET  THE  LAST  FA(‘T  TO  BE  CHECKED 
D2  =  (PIN(3)  -  Z’.llNl^TANTHP 
DO  60  I  =  I  1 . NT  I  P 
IF(S( I ) .GE.02)  GO  TO  65 
60  CON  T I NUE 
65  12  =  I 

else 

UPWARD  ray 

TANTHP  =  TanI ALUS(XI IN( 3) ; ) 

C  GET  FIRST  FACET 

IF(PIN(3) .LT.ZMIN)  THEN 
C 

C  INITIAL  POINT  BElOW  THE  MINIMUM  SURFACE  (INITIAL  RAV) 

01  =  (ZMIN  -  PIN( 3) ) *TANThP 
DO  70  1=2, NTIP 
I F ( S( I ) . GE . D1 )  GO  TO  75 
70  continue 
75  I  1  =  I 
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ELSE 

INITIAL  POINT  ABOVE  THE  MINIMUM  SURFACE  (DAUGHTER  OR  LOW-ANGLE  RAV ) 

11  =  2 
ENDIF 

GET  last  facet  TO  BE  CHECKED 
D2  =  (ZMAX  -  PIN(3) )»TANThP 
DO  80  I=I l.NTIP 
IF(S{I  )  .GE.D2)  GO  TO  85 
80  continue 
85  12  =  I 
ENDIF 

12  =  MI  NO ( I  2 , NT  I P ) 

CHECK  possible  PAIRS  OF  TRIAD  INTERCEPT  POINTS  FOR  A  FACET  INTERCEPT 
DO  100  1=11.12 

GET  THE  triad  NODE  VECTORS  CORRESPONDING  TO  INTERCEPT  POINTS  I  AND  I-l 
call  GETABCCVTIPC  1  ,  I  -  1  )  . VTIPC  1 . I  )  .KS( 1- 1  )  .KS( n  ,  A.B.C) 

SEE  IF  THE  RAV  TRACK  INTERCEPTS  THIS  FACET 

call  F INTCP(  I NRAV . a . B , C . pi N . XI  in . S( I  -  1 )  . S( I  )  .  INTCP.P.UON) 

IF ( INTCP . EQ. 1 )  GO  TO  200 
100  CONTINUE 

IF  HERE,  NO  INTERCEPT  WAS  FOUND 
lOUT  =  1 
RETURN 

IF  HERE,  AN  INTERCEPT  WAS  FOUND.  COMPUTE  THE  REFLECTED  AND 
REFRACTED  RAVS 

200  lOUT  =  0 

CALL  RSPL  I  T  (  R  IN  .  X  I  I  N  ,  UON  ,  RRE  F 1.  ,  X  I  RE  F  1  .  RRE  F  R  .  X  I  R  E  F  R  ) 

C 

RETURN 

C 

END 
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Subroutine  triadsinhex) 

c 

ON  nhmi/triaos 

GIVEN  The  order  OF  THE  HEXAGON.  NnEX .  THIS  ROUTINE  DEFINES  THE 
VECTOR  NODES,  FNODE,  OF  THE  HEXAGON  TRIADS  IN  UNITS  OF  DELTA  AND 
EPSILON,  AS  IN  63/PAGE  26. 

PARAMETER (MXNHEX= 7 ,  MXN0DE=3‘MXNHEX» (MXNHEX+ 1 )+ 1 ) 

COMMON/ CNODES/  NNODE , FNODE ( 2 . MXNOOE ) 

COMMON /CM I  SC/  IMISCl 20) .FMISC(20) 

DELTA  =  FMISCI 16) 

EPS  =  FMISC( 17) 

NF  =  0 
IPRINT  =  0 

DO  100  IC='NHEX.NhE< 

CEPS  ^  FLOAT! IC ) *EPS 
IF (MODI IC . 2) . EQ. 0 )  ThEN 

C  IS  EVEN 

MXB  =  NHEX  -  IABS(IC)/2 
DO  200  IB=-Mxa,MXB 
NF  =  NF  »  1 

FNODE(l.NF)  =  FlOA T ( I B ) »0£uTA 
200  FN0DE(2,NF)  =  CEPS 

else 


C  IS  ODD 


MXB  -  NHEX  -  (  1AB.(  lO’ 1  )/2 

DO  210  IB=-MXB,0 
NF  =  NF  1 

FNOOE(I.NF)  =  ( -0 . 5»FL0AT I  IB  )  ) ’UEl  I A 

210  FN0DE(2.NF)  =  CEPS 
DO  212  IB=0.MXB 
NF  =  NF  *  1 

FNODe(l.NF)  =  ( 0 . S*FlOAT( IB n *OEl T A 

212  FN00E{2,NF)  =  CEPS 
ENDI  F 

C 

100  continue 

c 

NNODE  -  3*NHEX» ( NhEX»  I  )  »  1 

I  F  (NF  ,  EQ  .  NNODE  )  TriEN 

I F ( I  PRINT , EQ .  1 )  WRITE (6, 300)  MNUOE . NHEX 

else 

WRITE(6,302)  NHEX , NF , NNODE 

STOP 

ENDI  F 

C 

I F ( I  PR  I  NT . EQ ,  1  )  'HEN 
WRITECe. 304) 

00  306  I  =  l,NN00f'.S 

JOd  WRITE(6.308J  I  ,  1  '  4  ,  (  FNOOE  (  1  .  I ’■U  )  .  FnuOE  (  2  .  1  ♦  J  )  .  J  =  0 . 4  ) 
ENDI  F 

C 

RETURN 


30L  FORMAT(lHn,'  SuB  tpiaDS; 
112,  hEXAGONA  l  jP I D '  ) 


I 


NIjIitS  defined  for  AN  ORDER' 


302  format ( IHO . 

1  I  4 , 4X  ,  NNODE 
304  FuRMA  T (  IMO , 
JOB  FORMATIIH 
END 


ERR(,w  IN  SuB  triaCj-,  //im  . 
=  .14) 

IHE  nExAGUN  OR  I  !■  NUDES  ARE 
NUDE  S'.  13.  '-'.13.  AT'.BI 


NHEX  -  ■  ,  I  2 , 4X ,  ' NF  = 


LUt  A  TED 
(  .E7.  2 


AT 


/ ) 

.  F  7 


)  •  )  ) 
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program  MAiNdNPUT.OuTPUT, tapes- input. TAPEb-OUTPUT, tape  16. tape  17 

1  TAPE  18 . tape  19 . T APE  16 1 


I  this  is  PROGRAM  1  OF  THE  NATURAL  HVOROSOL  MODEL  » 

ON  NHMl/MllQO  FTN5/FTN200 

THIS  PROGRAM  BEGINS  COMPUTATION  OF  THE  QUAD- AVERAGED  GEOMETRIC 
reflectance  AND  TRANSMITTANCE  ARRAYS  WHICH  DESCRIBE  THE  AIR  WATER 
interface  for  a  given  wind  speed. 

THIS  special  VERSION  OF  MA I N 1  DOES  ONLY  ONE  INPUT  QUAD  (ONE 
ROW  OF  R  OR  T ) . 

note-  this  version  of  the  code  strives  to  minimize  the  EXECUdON 

TIME  AT  THE  EXPENSE  OF  MODULARITY  AND  READABILITY  OF  THE  CODE. 
SOME 'sections  of  frequently  EXECUTED  CODE  ARE  WRITTEN  AS  STRAIGHT 
line  CODE  WITH  SIMPLE  VARIABLES.  RATHER  THAN  BEING  GROUPED  IN 
subroutines  or  DO  LOOPS  with  ARRAYS.  IN  ORDER  TO  .^1= 

AND  INDEXING  OVERHEAD.  ALMOST  ALL  ERROR  CHECKING  AND  INTERMEDIATE 
OUTPUT  HAS  BEEN  REMOVED. 

THIS  PROGRAM  USES  THE  MONTE  CARLO  RAY  TRACING  TECHNIQUE 
DESCRIBED  IN  NuAA  TECH  MEMO  ERL-PMEl-6J.  COMMENTS  REFERRING  TO 
THIS  REPORT  are  prefaced  BY  63/.  THUS  63/2.12  REFERS  TO 
EQUATION  2.12  IN  tech  MEMO  63. 

references  without  The  63/  REFER  TO  NOAA  TECh  MEMO  ERl-PM£l-75. 
NUSFC  =  TAPE16.  .CONTAINS  ThE  RANDOM  SURFACE  REALIZATIONS 
RESULTS  OF  completed  RAY  PATHS  ARE  WRITTEN  TO  FILES  AS  FOLLOWS: 


NUUU  -  TAPE16.. 
NUDD  -  tape  17 .  . 

NuuO  =  tape  10  .  . 

NUUl:  =  TAPEI9.. 


.INITIAL  RAY  DOWNWARD.  FINAL  RAY  UPWARD;  R-  =  R(A.X) 

.initial  ray  DOWNviARO.  final  ray  DOWNWARD:  T-  =  T(A.X) 

INITIAL  RAY  UPWARD.  FiNAi.  RAY  DOWNWARD;  K*  -  R(X.A) 

.INITIAL  RAY  UPwARD.  FINAL  RAY  UPWARD:  T-f  -  T{X.A) 


program  2  READS  THESE  FILES  AND  TAl.iIES  THE  RESULTS  TO  GENERATE 
The  actual  R  and  T  ARRAYS. 

PARAMETER (MXMU- lO ,  MXPHI-24.  MxSTAw-lU.  MXMiEX-7) 
PAKAMeT£R(MXNOOE=3-'MXNHEX*(MXNHEX-^  lid.  MX  N  T  I  P  =  4  *  MX  NHE  X  i-  1  ) 

COMMON/CMUPHI /  0NDMU(MXMU) .BNOPhI (MXPHl I 

COMMON  /  CnOD  E  S  NNODE  .  F  node  {  2  .  MXNOOE  )  .  ZNODE  (  MXNODE  ) 

uOMMON/ChExuR/  nhEX .R1( 2 )  .R2( 2  )  .RIhAI  ( 2  I  .RZhaT  C  2 )  ,R  IRAT  ,  TARGET! 2) 
COMMON.' CT  IP'  N’  IP.SMIN.VTrP(2,M,»NTIPi  .S(MXNTIP)  .KS(MXNTIP)  .ZMIN, 

I  ZMAX 

COMMON  /  C  S'^ACK  '  nSTACK.STALK(MxSTaw.7) 

COMMON  /  CM  ISC.  ;  IyU  SC  I  20  )  .  FMI  SC  (  2i)  ) 

DIMENSION  PIN  I  j;.XIINiJ).P(T).XIREFll3),XIREFR(3) 

O  1  MEN  S  I  UN  NR  A  /  .yD  I  MXMU  )  .  NbRMH  (  10  I 
OOuBlE  PRECISI.N  DSEED 

data  R  a  DE  P  s  /  1  .  E  ■  1  0  /  .  NO  SF  T  .  .  .  NuL)[) .  NUOO  ,  N.  lUU  /  1  6  .  1  6  ,  I  7  ,  1  8  .  1 9  / 

data  NSTACK/'T.  .  KTRACE'Ij/.  NBRN.-H/  1  0  *  u  /  .  NREF  LO  .  NREFRO  ,  NT  I  R  /  3  ♦  0  / 

initialize  ■’Hi  PRUuRAM 

f,  A  L  Y  INI  Shl  (  IP  .  Y  S  .  NRA  YQO  ,  DSEEC' 

NM'i  =  I  MI  sc  I  1) 
rdZPI  -  I  MI  SC  I  Y  I 
PI  -  FMI SCI  1  ' 

IwOPI  :  2 . 0*PI 


(jE  T  Mu  BOUNCjAkILS  of  the  INCUMITyvj  uUAD 
FMUMIN  -  0. 

I  A  =  I ABS(  1 R ) 

IF(IA.GT.I)  FMUMIN  -  BNDMU(IA-l) 

DMU  -  BNDMU(IA)  -  FMuMIN 
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I F ( I  A . EQ . nMU )  TnEN 

C  ALL  PHI  values  fop  A  POlAR  CAP 

PHIMIN  =  0. 

DPMI  =  TWOPI 
ELSE 

PHIMIN  =  BNDPHI {N02PI  ) 

IF(jS.GT.I)  PHIMIN  =  3NDPHI(jS-1) 

DPMI  =  BNDPHI(2)  -  BNDPHl(l) 

ENOIF 

C 

NUMDU  =  0 
NUMDD  =  0 
NUMUD  =  0 
NUMUU  -  0 
NUMTPl  =  0 
L 

begin  computations  *•»»• 

c 

C  EACH  RAY  GETS  A  NEW  SURFACE  REALIZATION.  BUT  EACH  STORED  SURFACE 

C  realization  is  used  four  WAV'S  TO  EXPLOIT  SYMMETRY 

C 

nread  =  1 

NRAYTL  -  NRAYQD!  I A  ) 

DO  1000  NRAY= 1 . NRAYTL 

t. 

L  SELECT  A  Surface  realization 

c 

55  continue 

I F ( NREAD . EO . 1 )  ' "EN 

C  READ  A  surface  -FAlIZATION  AS  GENERATED 

READCNUSFC  .  END-‘30)  NSF  .  ZMIN  .  ZMAx  .  (  ZNODEI  I  )  .  I  =  1  .  NNODE  ) 

C 

ELSEI F ( NREAD . EQ . 2 )  THEN 

C  READ  the  surface  AS  ROTATED  BY  Inu  uEuREES 

READCNUSFC , END  =  50 )  NSF . ZMIN . ZMA^ .  ^  ZnOOE (  I  )  .  I = NNODE ,1,-1) 

C 

Else  IF (NREAD . EQ . 3 )  THEN 
C  READ  the  surface  AND  INVERT 

REA0(NU3FC,END=50)  NSF .ZMIN.ZMA* , ( ZNODE ( I ) . 1 = 1 , NNODE ) 

00  502  1=1. NNODE 
502  ZNODEC I )  =  -ZNODEC I ) 

C 

EL SE I F ( nread . EU  U)  Then 

C  READ  The  surface  AS  ROTATED  BY  Ibu  Dl>,.REES  AND  THEN  INVERT 

READ  (  Nu  SFC  ,  ENC)  =  h,.' )  NSF  .  ZM  I  N  .  ZMA  >  .  i  Z NONE  1  I  I  .  1  =  NNODE  ,  1  ,  -  1  ) 

DO  504  I  =  l,riNCDE 
5u4  ZnCjDElI)  =  -ZNODEC  I) 

EnDI  F 

(. 

GO  TO  506 

i.  END  OF  file  pro  ESSING  FOR  THE  SluKEU  ElLt  OF  CAPILLARY  SURFACES 

5U  WRirE(6,514J  NREAD 
NREAD  =  NREAD  -  1 

nread  =  MOD  I  NR E A D . A ) 

K  L  rt  1  N  D  N  .  J  S  F  C 
Rf  AD  I  Nu  SF  I  I  hE  a  C'ER 
READ  I  N'JSFC  !  HE.  ''ER 
GO  TO  55 
5  u  6  C  0  N  T  I  u  E 


C  select  a  RANDOM  RAY  DIRECTION  WITHIN  :mE  INPUT  QUAD 

C 

C  CHOOSE  A  RANDOM  MD  yA^UE 

;77  RMU  =  (FMUMIN  y  (.GuBFS(DS£ED)*DMuj ‘SIGNC 1 .G.FlOATC IR) ) 

C  no  rays  from  -•'[  POLE  ITSElF 

IFIABSCRMI.)  C.f  .  j-kADEPS)  nO  to  777 
ROOT  =  SQRTCl.u  -  RMU»RMU) 

C 

C  CHOOSE  A  random  PHI  VALUE 

SPMI  =  AMODCPhIMIN  y-  GGUBF  S  (  DSEED  )  »DPhI  ,  TWOPI  ) 

C 

c  LOCATE  the  initial  starting  point  for  This  target  and  direction 
c 

C  FOLLOW  The  TRAly  backwards  to  The  boundary  to  get  smin 

c 
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C  define  the  initial  RAV  direction  to  be  -XI  PRIME 
XIIN(l)  =  R00T»C05( SPHI ) 

XIIN(2)  =  ROOT»SIN( SPHI ) 

XIIN(3)  =  RMU 

CALL  TIP(TARGET,x; IN,0) 

C  DEFINE  THE  INITIAL  POINT  ON  THE  HEXAOON  BOONDARV 

TEMP  =  SMIN/ FMI SC ( 20  ) 

PIN(i)  =  TARGET(l)  T£MP*XIIN(1) 

PIN(2)  =  TARGET(2)  >  TeMP*XIIN(2) 

PIN(3)  -  TEMP«XIIN(3) 

RESET  XIIN  TO  The  INCOMING  DIRECTION.  XI  PRIME 
XI IN(  I  )  =  -Xl IN{  1) 

XIIn(2)  -  -XIIN(2) 

XI IN(3)  =  -XI IN(3) 

RAD  =  1.0 
INRAV  =  1 
C 

C  PERFORM  RAV  TRACING  COMPUTATION^ 

THIS  IS  The  RECURSIVE  TREE  FOR  A  GIVEN  INITIAL  RAV  + 

C 

KBRNCH  =  0 

999  call  trace (  I NRAV . rad. pi N . xl IN .  1 Ou I  . P . RREE L . X 1  RE F L . RREr R . X 1  REF R ) 

XTRACE  =  KTRACE  ^  1 

KBRNCH  ■=  KBRNCh  1 
INRAV  =  0 

L 

c  Check  for  rav  having  left  the  hexagon 
c 

IF(  iout.eq,  1)  Then 

c 

C  RAV  had  no  facet  intercepts. 
c 

C  GET  the  quad  indices  OF  THE  FINAL  RAV  DIRECTION 

PHIFIN  =  AMOD( ATAN2 (XI IN( 2)  . XI  INI  U ) »TW0PI  , TwOPI ) 

AMUFIN  =  XI IN(3) 

CALL  MPI NDX ( AMUF IN . PHI F IN . KU . LV ) 

C 

C  RECORD  The  RESULT  FOR  The  APPROPRIATE  R  OR  T  CONTRIBUTION 

C 

I F ( IR . GT . 0 )  THEN 
C 

(  DOWNWARD  initial  RAV 

I F ( AMUF I N . GT . 0 . 0 )  Then 
L  UPWARD  final  rav 

NUMDU  -  NUMOU  *■  1 
WRITEINUDU)  I R . OS . KU . LV . RAO 
ELSE 

C  DOWNWARD  FINAL  RAV 

NUMDD  =  NUMDD  ♦  1 

WRITE(NUDD)  I  R  .  .jS  .  KU  .  L  V  .  RAD 
ENOI  F 
C 

E^SE 

C 

C  UPWARD  I  NT  I  A  i.  RAV 

I F ( AMOF I N . GT . 0 . O )  TmEN 
C  UPWARD  final  rav 

ifirao.eo.1.1.-  ~ 

c  ERROR  RAV.  DuE  '  ^Iftl'E  hEkAGON 

NUM  T  P  1  V  NOW’  L  1  •  1 

E..^E 

Nuf.V'U  V  f^uMuU  V  ; 
wRITEINUJvj)  -IP.  .s.ko.lv.RAU 
END  I  F 


C  DOwNwAk.j  Flr^At  LA.' 

N.^Muo  V  mjMvjD  •  : 

WR  1  T  t  I  N.J  ..c.  I  1  R  .  .J  S  ,  KU  .  L  V  .  R  AD 
F  N  0  I  F 
ENOI  L 

( 


36 


n  o  n  n  r.  o  o  r-.  o  o  r  n  n  n  o  n  n  r,  r-  n  n  n 


§2.  PRCXjRAM  1 


HAV  INTERSECTED  A  FACET.  PUSH  REFLECTED  AND  REFRACTED  RAVS  INTO 
STACK  FOR  further  TRACING.  (DISCARD  RAVS  WITH  RADIANCE  . LE .  RAOEPS) 

ifcrrefl.gt.radeps)  then 
CALL  push{rrefl,p,xirefl; 

ELSE 

NREFLO  =  NREFlO  ♦  1 
ENDIF 

I F (RREFR . GT . RADEPS )  THEN 
CALL  PUSH( RREFR , P . XIREFR ) 

ELSEIF {RREFR . LE . 0 . 0 '  THEN 
NTIR  =  NTIR  +  1 

else 

NREFRO  =  NREFRO  +  1 
ENDIF 

ENDIF 

HAVE  ALL  RAVS  BEEN  FOLLOWED  TO  TERMINATION 
I F (NSTACK . GT . 0)  THEN 

REAO  A  NEW  RAV  FROM  THE  STACK  AND  TRACE 

CALL  PULL(RA0,PIN,X1 IN) 

GO  TO  999 
ENDIF 

THIS  IS  the  End  OF  THE  RECURSIVE  TREE  FOR  THE  GIVEN  INITIAL  RAV  + 
I  F ( KBRNCH. LT .  lO )  1 hEN 

N8RNCH( KBRNCh )  =  NBRnCh ( KBRNCh )  »  1 

Else 

nbrnch{io)  =  nbrn^mi;  10)  *  i 

ENDIF 

lOOU  continue 

»♦•»»  end  of  computations 

endfile  NUOU 
enofile  NUOD 

ENDF I lE  NUUD 

endfile  nuuu 

WRITE(6,600)  NRA vTl , KTRACE 

WRITE(6,60I)  NREFLO. RADEPS. NREFRO. RADEPS. NTIR 
WR  I  TE  (  6 . 60  2  )  NUMO'J  .  NUMDD  .  NUMUD  .  NUMUU  .  NUMTP  1 
WR I  TEC  6 . 604)  C  K . .  10 )  .  ( NBRNCH ( K )  . K^2 .  10  ) 

WRITE(6. 1002) 

FORMATS 

514  FORMATtlHO.'  NREAO  =  ’  .  I  2 . 3X . 

I'FILE  OF  SURFACE  FLAlIZATIONS  ExhAi.STED.  FILE  REWOUND.’) 

600  FORMATCIHO.'  END  OF  COMPUTATIONS’// 

1 IH  .110.'  total  rays  WERE  STARTED  FROM  THE  SELECTED  QUAD’// 

21H  .110,’  total  RAYS  WERE  TRACED  TO  COMPLETION’) 

601  FORMATC  IHO .  I  5 .  ’  REFlECTEO  RAVS  WITH  RADIANCE  . L T .  ’  .  1 PE9 .  1  . 

1’  WERE  DI SCARDED ’  '  1 6 .  ’  REFRACTED  RAVS  WITH  RADIANCE  .LT.’. 

2E9.1.’  WERE  DI SCARDED ■// IH  .’  ThERE  wERE’.I6. 

3’  total  internal  reflections  ) 

602  FORMA T (  IhO .  I  10 .  ’  RAYS  STARTED  DOWNWARD  AND  FINISHED  UPWARD’// 

llH  .110.’  RAYS  started  downward  AND  FINISHED  DOWNWARD’// 

21h  .110.’  RAYS  SfaR’^ED  jPwARD  AND  FINISHED  DOWNWARD’// 

31H  .110.’  RAYS  started  upward  and  finished  UPWARD’// 

41m  ,110,  rays  S'AR’'eD  UPWARD  AND  finished  upward  with  rad  =  1 

5.0  {01 SlAROED)  ! 

604  FORMAT) IMU,’  branch  OCCURRENCE  TALLY’ //’  NUM  BRANCHES: 

18110,17,  OR  MURE  /  NuM  OCCURRENCES 9  I  10  ) 

1002  FORMAT) IHO,  NORMA,  EXIT  FROM  NHMl’l 
END 
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subroutine  ini SHL ( IR . JS . NRA VOD, DSEED) 

C 

C  ON  NHMl/INllQD 

C 

C  THIS  routine  initializes  NHMl/MllQD 

C 

C  TWO  INPUT  RECORDS  ARE  READ: 

C  RECORD  1  (DEFINES  TME  HEXAGON  GRID  AND  THE  WATER  SURFACE); 

C 

C  IDBUG  =  0  FOR  MINIMAL  OUTPUT 

C  =1  FOR  GREATER  OUTPUT 

C  =2  FOR  Full  DEBUGGING  OUTPUT 

C  IGENSF  =  0  IF  A  FILE  OF  RANDOM  SURFACES  ALREADY  EXISTS  (USUAL  CASE) 

C  .GT.O  IF  THIS  IS  A  SPECIAL  RUN  FOR  GENERATING  AND  SAVING  A 

C  file  of  RANDOM  SURFACES.  IGENSF  SURFACES  WILL  BE  GENERATED. 

C  NHEX  =  THE  ORDER  OF  THE  HEXAGONAL  SURFACE  GRID  (=  MXNHEX  FOR  EFFICIENCY) 

C  WNDSPD  =  the  wind  SPEED  IN  M/SEC  AT  12.5  M  ELEVATION 

C  DSEEO  =  the  seed  FOR  RANDOM  NUMBER  GENERATION 

C 

C  RECORD  2  (DEFINES  THE  QUAD  GRID  AND  SELECTS  THE  INCOMING  RAY  QUAD); 

C 

C  NMU  =  The  number  of  mu  cells  in  one  hemisphere  (0  10  PI/2) 

C  NPHI  =  THE  NUMBER  OF  PHI  CELLS  (,  0  TO  2*PI).  MUST  BE  A  MULTIPLE  OF  4 

C  MUPART  =  1  IF  ALL  QUADS  ARE  TO  hAvE  EQUAL  SOLID  ANGLES 

C  2  IS  All  QUADS  ARE  TO  nAvE  EQUAL  DELTA  THETA  VALUES 

C  IR  =  the  index  of  The  input  mu  quad  (  -NMU . -1,1 . NMU) 

C  JS  =  The  index  cf  the  input  phi  quad  (1 . NPHI/4  +  1) 

C  NUMRAY  =  The  number  OF  RAYS  TO  BE  TRACED  FROM  THE  INPUT  QUAD 

C 

PARAMETER(MXMU= 10 ,  MXPHl=24) 

parameter  (MXNHEX  =  7  ,  MXN0DE  =  3*MXnmEX»  iMXNH£a+  1  )  ■»  1  ) 

COMMON/CMUPHI  /  BNDMU(MXMU)  .BNDPi-il  (MXKnl  ) 

COMMON/CNOOES/  NNOOE . FNODE( 2 .MXNODE ) . ZNODE ( MXNODE ) 

COMMON /CHEXGR/  NHEX .R1(2).R2(2).R  InAT ( 2 )  . R2HAT ( 2 )  , R  IRAT , TARGET ( 2 ) 

COMMON /CM I  SC/  I M I  SC ( 20  )  .  FMI SC  I 2u ) 

DIMENSION  OELTMU(MXMU) .FMu(MXMU) .PhI (MXPhI ) ,OMEGA(MXMU) 

DIMENSION  NRAYQO(MXMU) 
double  PRECISION  DSEED 
C 

data  pi .RA0£G,REFR/3. 141592654.  57.2957795,  1.333333333/ 

DATA  delta,  EPS/1.0.  1.111/,  TARGET/U.5,  0.370333333/ 

DATA  NUSFC.NUOU. NUDO , NUUD.NUUU/ 15,16.17,18,19/ 

C 

L  READ  the  input  RECORDS 

C 

R£A0(5, ♦)  IDBuG, IGENSF. NHEX. WNUiPD, USE ED 
WRITE(6.300)  NHEx. WNDSPD. DSEED 
I F ( IGENSF . EQ . 0 ;  then 

READ(5,*)  NMU.NPmI.MUPART.IR.jS. NUMRA / 

WRIT£(b.3Ul)  NMu.NPhI , IH.jS.NuMkAY 


C  STORE  the  needed  PARAMETERS 

C 

IMI  SC(  1  )  =  NMi, 

IMISC(2)  =  NPh; 

IMI  SCO)  =  IDBuG 
IMI SC ( 17 )  -  NUMRAV 

FMI SCI  1  )  =  PI 
FMISC(3)  =  RADEG 
FMI SC ( 15 )  =  WNDSPD 

FMIiCll6)  =  DE:.TA 
FMI sCl  1/  )  =  EPS 

<-MISC(l8/  =  RE-fi 

RAU48  IS  The  vCRITICAL  ANGlE  fur  lUlAL  internal  reflection 
PAD4H  =  ASIN(  i  . o/REFR  ) 

FMI SC  T  19 )  =  RAD48 
C 

I  F  (  IGENSF  .  GT  ,  11)  THEN 
C 

^'*****^FiIS  IS  AN  INI  IAL  RUN  FOR  GENERATION  OF  A  FILE  OF  RAT) DOM  SURFACES 
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WRITE(6,304) 

REWIND  NUSFC 
C 

C  CHECK  TO  SEE  IF  NUSFC  IS  EMPTY 

REAOtNUSFC ,END=50)  DUMMY 
STOP  'SURFACE  FILE  ALREADY  EXISTS' 

50  REWIND  NUSFC 

DEFINE  THE  GRID  VECTORS  AS  IN  63/PAGES  24-26 

GAMMAl  =  1 . 0/SQRT(0 . 25*DELTA»DELTA  £PS»EPS) 

R1{1)  =  0 . 5*DELTA«GAMMA 1 
R1(2)  =  EPS»GAMMA1 

R2( 1)  =  -Rl(  1) 

R2(2)  =  Rl(2) 

R1HAT( 1)  =  -R1C2J 
R1HAT(2)  =  Rl( 1) 

R2HAT(  1)  =  -R2(2) 

R2HAT(2)  =  R2(1) 

RIRAT  =  -2 . 0»EPS/DELTA 

DEFINE  THE  HEXAGONAL  SURFACE  GRID  NODE  LOCATIONS 

FMISCC 16)  =  DELTA 
FMISC(17)  =  EPS 
call  TRIADS(NH£X) 

WRITE  the  HEADER  RECORDS 

WRITE (NUSFC)  IGENSP . NHEX . NNODE . WNDSPD . DSEED 
WRI TE(NUSFC )  R 1 . R2 . R IHAT . R2HAT .RIRAT . FNOOE 

DEFINE  THE  STANDARD  DEVIATION  FOR  SURFACE  HEIGHTS  BY  63/2.1 

SIGSFC  =  0. 0357*SORT(WNDSPO) 

WRITe(6,302)  delta , EPS. SIGSFC 
C 

C  GENERATE  AND  SAVE  TmE  CAPILLARY  wAvE  SURFACE  REALIZATIONS. 

C  63/SECTION  2C 

C 

DO  55  NSFC=  I  , IGEMSF 
C 

C  DRAW  N(0,1)  RANCCM  NUMBERS 

CALL  GGNML ( DSEED , NNOOE . 2NODE ) 

C 

C  CONVERT  TO  N(Q,  5IGSFC**2)  RANDOM  NUMBERS 

ZMAX  =  -1.0E30 
ZMIN  =  1.0E30 
DO  99  IRAN= I . NNOOe 
ZN  -  SIGSFC*ZNODE( IRAN) 

ZNODE (  I  RAN )  =  ZN 
IF ( ZN . GT , ZMAX )  ZMAX  ^  ZN 
I F ( ZN . LT , ZMI N )  CM  IN  =  ZN 
99  CONTINUE 
L 

55  WRITE(NUSFC)  N SF T , ZM I N . ZMA X ,  ( ZNODE I  I  )  .  I  -  1  , NNODE ) 

C 

ENDFIlE  NUSFC 
WRITE(6,60)  IGENSF 
STOP 
ENDI  F 
C 

0»»»»*ThIS  IS  A  PROD'.jC  I  ON  RUN  FOR  RAY  TRAoiNG 

C  READ  the  existing  FIlE  OF  SURFACE  REALIZATIONS  AND  TEST  FOR 

C  C0MPA'''AB  I  L  I  T  Y  V-Ith  REQUESTED  PARAMETERS 

C 

WR  I  TE  I  6 , 308  ) 

REWIND  NUSFC 

READ(NUSFC)  NSFl.NHEXl, NNODE .WIND  1 
READ(NUSFC)  R1,R2,R  IHAT , R2hAT .RIRAT  . FNUUE 

C 

I F ( NHEX 1 , NE . NHEX  .OR.  WI ND 1 . NE . WNDSPD )  THEN 
WRITE(6.70)  NHEXI.WINDI 
STOP 
ENDI  F 
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c 

C  DEFINE  the  mu  AND  PHI  VALUES  WHICH  FORM  THE  QUAD  BOUNDARIES  FOR 

C  GEOMETRIC  DISCRETIZATION.  SECTION  3. 

C 

IF(MUPART.EQ. 1)  THEN 
C 

C  PARTITION  THE  UNIT  SPHERE  SO  THAT  ALL  QUADS .  INCLUDING  THE  POLAR 

C  CAP.  HAVE  EQUAL  SOLID  ANGLES 

C 

CALL  EQSANGCNMU , NPHI , DELTMU) 

C 

ElSEI F (MUPART . EQ . 2)  THEN 

C 

C  PARTITION  the  unit  SPHERE  INTO  EQUALLY  SPACED  THETA  VALUES 

C 

CALL  EQTHET{NMU.DEi-TMU) 

C 

ENDI  F 
C 

C  define  the  BOUNDARY  MU  VALUES  Bv  SUMMING  THE  DELTA  MU  VALUES 

BNDMU(  I)  =  DElTMUI.  1) 

DO  101  I=2.NMU-1 

101  BNDMU(I)  =  0NDMUCI-1)  +  OELTMU(I) 

BNDMU(NMU)  =  1. 

C 

C  DEFINE  the  Mu  VALuES  AT  THE  QUAD  CENTERS 

FMU ( 1 )  =0 . 5»OeLTMU( 1 ) 

DO  104  I=2.NMU 

104  FMuII)  =  0  .  S*  (BnDMU  (  I  -  1  )  BNOMUUT) 

C 

c  define  the  phi  values  at  The  Quad  centers,  and 

C  define  The  BOUNDARY  PHIS  BY  PHI  -  DPHl/2  TO  PHl  +  DPMl/2 

c 

DELPHI  =  2 . 0»PI / float (NPHI ) 

PHI ( 1 )  =  Q , 

SNDPHHII  =  0.5*DELPH1 

DU  102  J=2.NPh1 

PHI(J)  =  PHI(J-l)  1-  DELPHI 

102  BNDPHI(J)  =  0NOPh;(j-1)  f  DELPHI 
C 

C  determine  The  SOlID  ANGlE  of  TmE  yuAUS 

c 

DO  400  1=1. NMU' 1 
400  OMEGA! I)  =  DELPHI *DELTMui ! ) 

OMEGACnMU)  =  2 . 0*PI *DELTMU(NMU) 
lA  =  IABS( IR) 

NRAYQD(IA)  =  NuMRAY 

c 

WR  I  TE  (  6 , 3  10  ) 

UO  312  1=1. NMu 

THETaC  =  ACOS(FMU( I ) )»RADEG 

ThETaB  =  RADEG*ACOS( BNDMU (II) 

312  WRITE(6.314)  I . FMU ( I ) , ThETAC . BNUMU ( I ) . THETAB . DELTMU ( I ) . 

1  0MEGA( I ) .NRAY0D( I ) 

WRlTE(b.316)  DELPhIFRADEG 

C 

C  WRITE  header  RECORDS  FOR  OUTPUT  FILES 

C 

REWIND  NUOU 
REWIND  NUDO 
REWIND  NUUD 
REWIND  NUUU 

WRITE(NUDU)  NUDu.'DOWN  up  ■ . IR . JS , NRAYQD 

WRITE(NUOU)  IMISC.FMiSC.FMU.PHl. BNDMu . BNDPHI . OMEGA , DE L TMU 
writeinuDDI  nuod.'DOwn  down ■ . I r . jS . nr AYQD 

wR I TE ( NUDD )  I M I  SC . FMI SC . FMu . PmI  . BNDMu . BNDPHI  , OMEGA . DEL  TMU 
WRITE(NUUD)  NUuD.'UP  down  '  .  IR  .  ,JS  .  NRA  yQD 

WRITE! NUUO I  I  MI  SC . FMI SC . FMU . PhI  . BNljMU . BNDPhI  . OMEGA , DElTMU 
WRITE(NUUU)  NUUU.  'UP  UP  ■  ,  1  R  .  .:S  .  tjRA  YQD 

WRITE(Nuuu)  IMISC.FMISC.  FMU . PH  1  , BNDMu  .BNDPhI  . OMEGA .DElTMU 

C 

return 

(. 
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FORMATS 

60  F0RMAT(  IHO, I  10,  '  SURFACE  REALIZATIONS  GENERATED') 

70  FORMAT(1HO,-  SURFACE  REALIZATION  FILE  NOT  COMPATABLE  WITH  REQUESTE 
10  PARAMETERS'//'  NHEXl  =',I3.5K.  wINDl  =',F7.3) 

300  FORMAT! IHl,'  NATURAL  HVDROSOL  MODEL.  PROGRAM  1  (1-QUAD  VERSION)'// 
1'  MONTE  CARLO  AIR-WATER  SURFACE  RAV  TRACING  PROGRAM'// 

2'  THE  HEXAGON  GRID  PARAMETERS  FOR  THIS  RUN  ARE'// 

35X.'NH£X  =',I2,'  =  ORDER  OF  THE  SURFACE  GRID  HEXAGON'// 

ASX.'WNDSPD  ='.F7.3.'  -  THE  WIND  SPEED  IN  M/SEC  AT  12.5  M'// 
55X,'DSEED  = ' , 1PD20 . 10 , ■  =  ThE  SEED  FOR  RANDOM  NUMBER  GENERATION') 

301  FORMATClHO,'  THE  QUAD  GRID  PARAMETERS  FOR  THIS  RUN  ARE'// 

15X.'NMU  ='.I3,'  =  NUMBER  OF  MU  CELLS  IN  (0,PI/2)'// 

25X.'NPHI  -.13,'  =  NUMBER  OF  PHI  CEulS  IN  (0.2«PI)'// 

JS  ='.213,'  =  THE  INPUT  o.ian 

ASX.'NUMRAV  ='.110.'  =  THE  TOTAL  NUMBER  OF  RAVS  TO  BE  TRACED') 

302  FORMAT! IHO,'  THE  WAVE  FACET  PARAMETERS  ARE'// 

15X,  'DELTA  = '  .  IPEIO . 3/ /5X .  • EPS  =  '  . E  10 . 3 / / 5X .  ' S I GSF C  =',E10.3) 
304  FORMAT! IHO,'  THIS  IS  AN  INITIAL  RUN  FOR  GENERATING  A  FILE  OF  CAPIL 
ILARV  wave  SURFACE  REALIZATIONS') 

30e  FORMAT! IHO,'  THIS  IS  A  PRODUCTION  Run  FOR  RAY  TRACING  !1  QUAD)') 
310  FORMAT! IHO,'  THE  MU  VALUES  DEFINING  THE  QUADS  ARE'// 

15X,'I  CNT  MU  theta ' .ex, ' BND  MU  THETA  . 7X , 

2'DELTA  MU  SOLID  ANGLE  NRAVOO'/) 

314  F0RMAT!1H  ,  15 , 2 ! F9 . 4 , F9 . 3 . 4X)  . F9 . 4 . F 12 . 4 , I  10) 

316  FORMAT! IHO.'  THE  QUADS  HAVE  A  WIDTH  OF  DELTA  PHI  ='.F7.3. 

1'  DEGREES') 

END 
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3.  PROGRAM  2 

A.  Program  Description 

This  program  tallies  the  ray  information  from  Program  1  and  computes  the  four  quad- 
averaged  geometric  reflectance  and  transmittance  arrays,  using  75/9. la-d  and  75/9.7a-d.  Once 
again,  there  is  an  "all-quad"  and  a  "one-quad"  version  of  Program  2,  to  be  run  with  the  ray-data 
files  of  the  corresponding  versions  of  Program  1. 

Program  1  creates  all  four  ray-data  files  (Tapes  16,  17,  18  and  19)  in  one  run.  Program  2 
processes  these  rues  one  at  a  time,  in  four  separate  runs,  generating  fer  separate  output  files. 

After  running  Programs  1  and  2  and  studying  the  resultant  quad-averaged  geometric  r  and  t 
arrays,  the  user  may  decide  that  still  more  rays  should  be  traced  in  order  to  increase  the  accuracy 
of  the  computed  array  elements.  In  this  case.  Program  1  can  be  run  again  to  generate  a  new  batch 
of  rays.  Program  2  can  then  read  the  new  ray-data  files  from  Program  1 ,  read  the  output  files 
from  the  previous  run  of  Program  2,  and  merge  the  new  and  old  information  to  create  an  updated 
set  of  r  and  t  arrays.  This  repetition  of  Program  1  and  2  can  be  repeated  until  a  satisfactory 
number  of  rays  has  been  traced  and  the  r  and  t  array  elements  have  been  declared  sufficiently 
accurate. 

B.  Input 

Only  one  free-format  data  record  is  required; 

Record  1:  NEWRUN,  IDBUG 

NEWRUN  =  1  if  this  is  the  first  run  of  Program  2 

=  0  if  Program  2  has  already  been  run,  and  new  ray  data  are  to  be  merged 
with  existing  r  and  t  files  from  the  previous  run  of  Program  2 

IDBUG  =  0,  I  or  2,  as  in  record  I  of  Program  I 


C.  File  Management 

File  management  for  Program  2  depends  on  whether  this  is  an  initial  run  (NEWRUN  =  1) 
or  a  continuation  run  to  incorporate  additional  ray  data  (NEWRUN  =  0).  In  either  case,  four 
separate  runs  must  be  made  in  order  to  process  the  four  output  ray-data  files  from  Program  1. 
The  file  names  are  as  follows: 

Initial  run  (NEWRUN  =  1) 

There  is  one  input  file,  always  named  TAPE20.  This  file  is  either  of  TAPE16,  TAPE17, 
TAPE  18  or  TAPE  19  from  Program  1,  locally  renamed  as  TAPE20.  There  is  one  output  file  with 
symbolic  filename  of  NUOUT.  The  external  file  name  for  NUOUT  is 
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TAPE22 

TAPE23 

TAPE24 

TAPE25 


§3.  PROGRAM  2 


ifTAPE20  i5 


'TAPE16 
TAPE17 
TAPE  18 
-TAPE  19 


These  external  filenames  are  generated  automatically  by  Program  2.  The  user  should  save 
NUOUT  with  an  appropriate  descriptive  filename,  to  avoid  confusion  if  more  than  one  set  of 
runs  of  Programs  1  and  2  is  made. 


Continuation  run  (NEWRUN  =  01 

There  are  now  two  input  files,  always  named  TAPE20  and  TAPE21.  As  above,  TAPE20  is 

either  of  TAPE16,  -,TAPE19  containing  new  ray  data  from  a  second  run  of  Program  1.  TAPE21 

is  the  corresponding  output  file  from  the  previous  run  of  Program  2,  i.e.  TAPE21  is  the  renamed 

TAPE22, •••,TAPE25  from  the  previous  run.  The  output  file,  NUOUT,  is  corresponding 

TAPE22,  ”,TAPE25  and  contains  the  updated  r  or  t  array.  In  other  words, 

rTAPE16"i  rTAPE22^ 


if  TAPE20  is  the  new 


TAPE  16 
TAPE  17 
TAPE  18 
TAPE  19 


,  then  TAPE21  is 


TAPE23 

TAPE24 

TAPE25 


from  the  previous  run. 


and  NUOUT  is  the  updated 


TAPE22 

TAPE23 

TAPE24 

TAPE25 


The  most  convenient  manner  for  keeping  track  of  these  files,  if  multiple  runs  of  Programs  1  and 
2  are  made,  depends  on  the  particular  computer  system. 

The  final  versions  of  TAPE22,  •,TAPE25  contain  the  quad-averaged  geometric  arrays  as 
follows; 


TAPE22 

TAPE23 

TAPE24 

TAPE25 


^£(a,x) 

t(a,x) 

contains  <  — 

I  frx.a) 

lt(x,a) 


All  four  of  these  files  are  read  by  Program  3.  TAPE22  (r(a,x))  and  TAPE25  (t(x,a))  also  are  read 
by  Program  5,  if  the  contrast  transmittance  is  computed. 
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D.  Code  Listing 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


c 


c 

c 

c 

c 

c 

c 


c 


PROGRAM  MAIN( INPUT .OUTPUT . TAPE5- INPUT . TAPE6-0UTPUT . TAPE 20 . 
1  TAPE21 , TAPE22 . TAPE23 , TAPE 24 . TAPE 26) 


+  THIS  IS  PROGRAM  2  OP  ThE  NATURAL  HYDROSOL  MODEL  ♦ 


+  +  +  +  +  +  ♦  +  +  + 


ON  NhM2/M2AlL 

This  program  reads  an  output  file  written  by  nhmi/miall  and 
TALLEYS  THE  SCATTERED  RAYS  TO  COMPUTE  THE  CORRESPONDING 
GEOMETRIC  REFLECTANCE  OR  TRANSMITTANCE  ARRAY.  AS  DESCRIBED  IN 
SECTION  9. 

THIS  PROGRAM  COMPUTES  AND  STORES  THE  "TOP  HALF"  OF  RTGEO. 

SEE  section  128  FOR  THE  BluCF  SYMMETRIES  USED. 

INPUT ; 

NEwRUN  =  1.  IF  This  run  starts  from  scratch 
0,  IF  This  IS  A  continuation  run 

TAPE20  =  A  file  OF  RAY  DATA  WRITTEN  BY  NHMl/MlALL  AS 
TAPE16,  17.  18.  OR  19 

TAPE21,  IF  NEWRUN  =  0.  THE  FILE  22.  23.  24.  OR  25  WRITTEN  BY  THE 

PREVIOUS  RUN  OF  NHM2/M2A11,  ,  CONTAINING  THE  RTGEO  ARRAY 

OUTPUT ; 

NUOUT  -  TAPE22  IF  TAPE2U  1-  rAPnC  OF  NHM  I 

=  TAPE23  IF  TAPE20  IS  TAPE17  OF  NHMl,  ETC. 

parameter  (MXMU= 10, MXPHl =24 ) 

MXROW  AND  MXCOL  ARE  FOR  THE  TOP  HAlF  OF  RTGEO 
parameter  (MXR0w  =  MXMU*MXPHI/2.  MxCOl =MXMU*MXPHI  ) 

COMMON/CMUPHi /  FMU(MXMU) , PHI (MXPhI ) .OMEGA(MXMU) 

COMMON/CMISC/  IMISC(20) ,FMISC(20) 

DIMENSION  RTGE0(MXR0w, MXCOL) . NR AVQD ( MXMU ) 

CHARACTER  RTLAaL‘6 

initialize 

call  I  NI  SHL  (RTGEC.RTLABl, NUOUT . NEWRUN . NHA YQD ) 

NMU  =  IMI  SC  (  1  ) 

NPHI  =  IMISC(2) 

I08UG  =  IMISCO) 

RADEG  =  FMISC(3) 
mjMCOL  =  NMU*NPHI 
NUMROW  =  NUMCOl/2 
NREC  =  0 

READ  AND  ACCUMULATE  RAY  CONTRIBUTIONS.  THIS  IS  THE  SUM  OVER  OMEGA 
IN  9.1,  BUT  without  the  1/S  FACTOR.  The  SUM  OVER  J  IN  9.1 
WAS  DONE  AUTOMA  T  I  CAl.LV  AS  THE  RAY  wAS  TRACED  TO  COMPLETION. 

THE  INPUT  QUAD  0 R  .  S )  IS  (I.J);  THE  OUTPUT  QUAD  QiU.V)  IS  (K.L) 

lOLD  =  0 

I F( NEWRUN . EO . 1 /  WRITE(6,1U2) 

NPNT  =  0 

200  REA0( 20 , END=250)  I.J.K.l.RAD 
NREC  =  NREC  »  1 
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C  ANY  FINAL  RAYS  GOING  IN’O  A  POLAR  CAP  ARE  STORED  IN  COLUMN  NMU 

if(k.eo.nmu)  then 
JCOL  =  NMU 

else 

JCOL  =  K  +  (L-1)»NMU 
ENDIF 
C 

C  ANY  INITIAL  RAYS  XI  PRIME  GOING  TOWARD  A  POLAR  CAP  ARE  STORED  IN 

C  ROW  NMU.  COLUMNS  1.  2 . NUMCOL 

IF(I.EQ.NMU)  THEN 

I  ROW  =  NMU 

ELSE 

IROW  =  I  +  (J-1)*NMU 
ENDIF 
C 

I F C NEWRUN . EQ . ’  'ND.  I.NE.IOLD  .AND.  NPNT . LT . 25 )  THEN 

lOLD  =  I 

NPNT  =  NPNT  +  1 

WRITE(6, 104)  NR EC, I , J. K.L, RAD, IROW, JCOL 
ENDIF 
C 

RTGEO( IROW. JCOL)  =  RTGEO ( I  ROW . jCOl )  »  RAD 
GO  TO  200 
C 

250  WRITE(6. 110)  NREC 
C 

C  RTGEO  IS  NOW  proportional  TO  'HE  RADIANT  FLUX  TRANSFER  FUNCTION 

C 

C  CONVERT  THE  ray-tally  ARRAY  INTO  A  GEOMETRIC  R  OR  T  ARRAY  BY  9.7 

C  (INPUT  RAYS  XI  PRIME  ARE  IN  ThE  FIRST  QUADRANT  ONLY) 

C 

JPI2  =  NPHl/4  »  1 

DO  252  JS=1,JPI2 
MAXIR  =  NMU  -  1 
IF( jS.EQ. 1)  MAXIR  F  NMU 
DO  252  IRfI.MA'IR 
IROW  F  IR  ♦  (jS  -  1)*NMU 
C  NRAYQOC IR)  IS  S  OF  9.1 

FACTl  =  FMU ( I R ; ’OMEGA ( IR ) /Float ( nhAYODI  IR )  ) 

c  nun  polar  quads 

00  253  XU- * , NMu -  1 

C  FACT2  CONTAINS  Tnc  M'.'  AND  OMEGA  FACTORS  OF  9.7,  AND  1/S  OF  9.1 

FACT2  =  fact  1  '  ; FMU ( KU ) •OMEGAf XU) ) 

DO  253  LVFl.NPHi 
jCOl  f  kU  (Ly-1)‘NMU 

253  RTG£0(  IROW. JCOL)  f  f A CT 2 * RTGEO ( I  ROW . JCOl ) 

C  polar  CAPS;  KU  f  nMU 

252  R T&EO(  I  ROW , NMU )  =  F A C T 1 ’R TGEO ( 1  ROW . NMU ) / OMEG A ( NMU ) 

C 

C  RTUEu  IS  NOW  THE  QUAD- averaged  GEOMETRIC.  R  OR  T  ARRAY 

C 

C  fill  out  THE  REMAINING  ROWS  (THE  SECOND  QUADRANT)  OF  THE  "TOP  HALF" 

C  OF  RTGEO  BY  SYMMETRY  (SEE  PAGE  190). 

C 

C  (IP. I)  ARE  The  (ROW, column)  BlOCK  INDICES  OF  THE  KNOWN  BLOCK 

C  (ISP,  IB)  ARE  T,iE  BLOCK  INDICES  OF  THE  BLOCK  TO  BE  DEFINED 

C 

N34  =  (NPHI  ♦  3)/4 

nOPI  f  nPHI/2 
DO  30C  IPf2,N,.t: 

IBP  F  MOPI  +  2  -  IP 
I RTP  =  NMU* (IP  -  II 
I  RT0P  =  NMU  * (  I  HP  -  1  ) 

DO  300  IFI.NPHI 
IB  F  NuPI  *  2  -  I 
IF(IB.LE.O)  IB  =  18  +  NPHI 
IRT  F  nMu*(I  -  1) 

IRTB  F  NMU* (IB  -  I ) 

L 

C  COPY  THE  NMU  BY  NMU  BLOCK 

00  300  K=1,NM0 
DO  300  KP= 1 , NMU 

300  RT&EO(  IRTBP*kP,  IRTBfK)  =  R  TGEO  (  I  R  T  P*  KP  ,  I  RT K  ) 
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RESET  the  input  SECOND  QUADRANT.  OUTPUT  POLAR  CAP  DIRECTION 
(COLUMN  NMU),  WHICH  HAS  PICKED  UP  ZERO  VALUES  FROM  THE  INPUT 
FIRST  QUADRANT.  PHI  =  180  BLOCKS 

DO  310  IP=2.N34 
IBP  =  NOPI  +  2  -  IP 
IRTP  =  NMU*(IP  -  1) 

IRTBP  =  NMU*(IBP  -  1) 

DO  310  K=1.NMU 

310  RTGEOC  IRTBP  +  K  .  NMU  )  =  R  TGEO  (  I  R  TP-' K  .  NMU  ) 

RE-ZERO  The  INPUT  SECOND  QUADRANT.  OUTPUT  PHI  =  180  COLUMN.  WHICH 
HAS  PICKED  UP  NON-ZERO  VALUES  FROM  THE  INPUT  FIRST  QUADRANT. 

OUTPUT  polar  cap  (PHI  =  OJ  COLUMN 

JCOL  =  NMU*(NUP1  *  1) 

DO  312  I=1,NUMR0W 
3  12  RTGEO( I  .JCOL)  ^  0  . 

WRITE  the  final  ARRAY  TO  THE  Ou t Pu T  FILE.  ONLY  THE  'TOP  HALF"  IS 
STORED  ( SEE  PAGE  190  )  , 

DO  270  JC0L= 1 . NUMCOL 

270  WRITE(NUQUT)  ( R TGEO ( I R ,  JCOL )  . 1 R -  1 . NUMKOW ) 

ENDFILE  NUOUT 
WRITE(6.271)  NUOUT 

PRINT  selected  parts  OF  TmE  NEW  WTUEO 

The  specular  block  for  phi  prime  =  o 
IS  =  1 

WRITE(6.113)IS , RAOEG*PHl { I S) . I S . RADEG»PhI (IS).RTLABL,(J,J=1. NMU) 

00  114  1=1. NMU 
THET  =  RA0EG*AC0S( FMU( I)  ) 

114  WRITE(6.115)  I . I , THET . (RTGEOC I . J ) . J= 1 .NMU) 

C 

C  the  SPECULAR  BLOCK  FOR  PHI  PRIME  =  90 

IS  =  NPHl/4  »  1 

IRl  =  NMU*( IS  -  1)  +  1 
IR2  -  IRl  1-  NMU  -  1 

WRITE(6,113)IS.RA0EG»PhI(IS).IS,RADEG*PHI(IS).RTLABL,(J.J=IR1,IR2) 
DO  116  1  =  1R1  . IR2 
IR  =  M0D( I .NMU ) 

IF(IR.EQ.O)  IR  =  NMU 
ThET  =  RADEG»ACOS(FMU( IR)  ) 

116  WRITE(6.115)  I , IR , ThET . (RTGE0( I . J ) . J=IRl . IR2) 

I F ( IDBUG . EO . 1 )  CALL  P2 AR A Y ( R TGEO , 2 ♦ NMU . 2 ♦ NMU . MXROW , 2 , 

1'  THE  UPPER  LEFT  BLOCKS  OF  THE  NEW  RTGEO  ARRAY') 

I  F  (  lOBuG  .  EQ  .  ’  Call  P2ARA  Y  (  RTGEO  .  NuMROW.  NUMCOL  .  MXROW  ,  2  , 

1'  The  top  half  of  the  full  RTGEO  array) 

WRITE(6.605) 

c 

c  formats 
( 

1C2  FORMATflHO,'  selected  RAY  DATA;  NREC  IR  JS  KU  '  , 

1  LV  FRESNEl  RT  ROW  CUl ■  /  I 

;04  FORMATCIH  ,  I  10 . 4  I  5 , F 10 . 5 . 18 ,  16 ) 

llU  ‘^ORMA'l'llH  .110,  DATA  RECORDS  READ  FROM  UNIT  20  ■  ) 

113  FOR;.’aT(  IMO  .  '  (SPECULAR)  BLOCK  FOR  PhI  PR  I  ME  (  '  ,  I  2  .  '  )  =',F6.1, 

1'  AND  Pr;r(',I2,)  ='.F6.1,'  OF  THE  NEW  '.Ab.  ARRAY'// 

2 1 7X , ' COLUMN ;  '.10110/ 

:)3  3X.'MU(1)  MJ(2)  Mu(3)  Mu(4)  MU(5)  Mu(6)  M 

4U(7)  Mu(8)  MU(9)  MU(IO)'/) 

115  F0RMAT(  ROw',14,'  MU('.I2.')  = '  . Fb .  1  , 4X .  10 ( 2X  ,  F8  5)  (/24X 

1  10( 2X , F8 . 5)  )  ) 

271  FORMAT(1HO,'  EOF  WRITTEN  ON  FIlE  liuOuT  =  TAPE', 12) 

605  FORMAT(lhO,'  normal  EXIT  FROM  NHM .  PROGRAM  II  ') 

END 
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subroutine  1  N1  SHL  (  RTGEO . RTlABL .NUOuT . NEwRUN . NRAYQD ) 

ON  NHM2/IN2ALL 

THIS  routine  INITIALIZES  PROGRAM  NMM2/M2ALL 
PARAMETER  (MXMU=10.  MXPMI=24) 

PARAMETER (MXROW=MXMU*MXPHI /2 .  MXCOl=MXMU*MXPHI ) 

DIMENSION  RTGEO(MXROW.MXCOL) 

DIMENSION  NRAVQD(MXMU) , BNDMU ( MXMU ) .BNDPHI CMXPHI ) , DELTMU ( MXMU ) 
DIMENSION  IMISC2(20) ,FMISC2(20) . NRAQ02 ( MXMU ) 

COMMON/CMUPHI /  FMU(MXMU) , PHl (MXPHI ) .OMEGA(MXMU) 

COMMON /CMI SC/  IMISC(20) .FMISC(20) 

CilARACTER  UPD0WN»9  ,  RT L ABL  •  6  ,  UPDN2  *9  .  RTL  AB2 *6 

READ(5.*)  NEWRUN. lOBUG 

READ  HEADER  RECORD  OF  RAV  DATA  FILE  (TAPE16,  17.  18,  OR  19) 

REWIND  20 

REA0(20)  NU2Q , UPDOWN , NRAVQO 

READ(2Q)  IMISC.FMISC.FMU, PH I . BNDMu . BNDPHI .OMEGA .DELTMU 

NMU  =  IMISC( 1) 

NPHl  =  IMISC(2) 

NUMRAV  =  IMISCC  17  ) 

RADEG  =  FMISC(3) 

WNDSPD  =  FMI SC(  lb ) 

REFR  =  FMI SC (  18  ) 

IMISCO)  =  IDBUG 

NUOUT  =  NU20  +  6 
IPI2  -  NPHI/4  »  1 

1 F (UPDOWN . £Q DOwN  DOWN')  THEN 
RTLABL  =  'TCA.X) 

ElSEI F (UPDOWN . EQ UP  UP  ')  THEN 
RTLABL  =  'T(X,A)  ' 

Else  I F ( UPDOWN . EQ DOWN  UP  ')  THEN 
RTlABL  =  -RIA.X)' 

else  I F ( uPDOwN . EQ ,  UP  DOWN')  THEN 
RTuABL  =  ■ R ( X  .  A  )  ■ 

ELSE 

WRI TE( 6 , 118)  UPDOWN 
STOP 
ENDI  F 

NUMCOL  =  NMU*NPhI 
NUMROW  =  NUMCOl/1 

WRITE(6.100)  RfiABL, UPDOWN . NMU , NPhI . wNDSPO .REFR 
WRITE(6. 110)  NUMRAV 

IF ( NEWRUN . EQ . 1 )  THEN 
this  IS  A  new  RuTJ.  ZERO  RTGEO 

ZERO  ONLY  THOS.  array  ELEMENTS  WHICH  ARE  ACTUALLY  USED  FOR  STORAGE, 
AS  AN  AID  TO  DEBUGGING  ON  THE  665 
DO  98  JC0L= 1 . NUMCOL 
DO  98  I ROW= 1 , NUMROW 
96  RTGEO( IROw , JCOl '  =  0. 

NON  POLAR  OUTPUT  QUADS 
DO  98  IV-1,NPHI 
00  98  I U= 1 , NMu-  : 
jCOL  =  ID  I  I  V  -  1  )  *NMU 
C  NON  POLAR  input  QUADS 

DO  99  I  S-  1  ,  I  PI  2 
00  99  IR= 1 , NMU- I 
I  ROW  =  I  R  +  {  I  -  1  )  »NMu 
99  RTG£0( IROw, JCUl;  ^  0. 
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u  POLAR  CAP  INPUT  (JUAD 

98  RTGEOINMU, JCOl )  =  0. 

C  NON  POLAR  input  QUADS.  POLAR  CAP  OUTPUT  QUAD 

DO  97  I S=  1  ,  I  PI  2 
DO  97  IR=1,NMU-1 
IROW  =  I R  +  ( I S- 1 ) ‘NMU 

97  RTGEOC IROW.NMU)  =  0, 

C  POLE  TO  POLE  QUADS 

RTGEO(NMU,NMU)  =  0. 

C 

ELSE 

C 

C  THIS  IS  A  continuation  RUN.  READ  EXISTING  RTGEO  (TAPE21  ^  NUOUT  OF  PREVIOUS  RUN) 

REWIND  21 

REAO(21)  NU21,NRAQD2,IMISC2.FMIGC2 

C 

NMU2  =  IMI SC2(  1  ) 

NPHIi  ^  IMISC2C2J 
NUMRA2  =  IMI SC2 ( 1 7 ) 

WNDSP2  =  FMI SC2 (  15 ) 

C 

C  CHECX  FOR  COMPATIBLE  FIi.ES 

I F ( NUOUT  . NE  .  NU2  1  .OR.  NMu.NE.NMU2  .OR. 

1  NPHi .NE.NPHI2  .OR.  WNDSPD.NE.WNOSP2)  THEN 
WR  I  TE  f  6 , 200  ) 

WRITE(6.202)  NU20. NMU .NPHi . WNDSPD 
WRITE(6.202)  Nu21, NMU2 .NPhI 2 . WNDSP2 
STOP 
ENDI  F 
C 

C  the  -top  half-  OF  RTGEO  IS  STORED 

C 

DO  130  JC0L= 1 , NUMCOL 

130  ReAD(21J  iRTOC: ; ! R , JCO: ) . IR= 1 . NUMROW) 

WRI TE ( 6 , 1 12 )  RTlABL , NUMRA2 

PRINT  SELECTED  PARTS  OF  THE  EXISTING  RTGEO 

The  specular  Block  for  Phi  prime  =  o 
I S  =  1 

IV  =  IS  ♦  NPmI/2 
jC 1  =  NMU* I  I V  -  I  )  *  1 

JC2  =  jCI  *  NMU  -1 

WR I TE I  6 ,  1  13 )  I S . R AD£g*PhI  I  I S )  .  I  V , RA0EG*PHI  (IV).RTLABL.(J,J  =  JC1,JC2) 

DO  114  1=1, NMU 
THET  =  RAD£G*ACDSI FMu( I ) ) 

114  WRITE(6.115)  I . tm£T . ( rigEOI I . J 1 . J= JCI . jC2) 

THE  specular  Block  for  phi  prime  =  90 

IS  =  NPHl/4  *  1 

I V  =  IS*  NPHI  / 2 
I R 1  =  NMU* (IS  -  1  )  *  1 

IR2  =  IRl  *  NMU  -1 
jC 1  *  NMU* (  I  V  -  1  )  *  1 

JC2  JCl  *  NMli  -1 

wRITEt6.113)IS. R a DEG* PHI  C I S )  . I v  . RADEu*PHI  (IV). RTLABL.  (J,J  =  JC1,JC2) 

DO  116  I  -  I R  1  .  I R2 
IR  =  MOD{ I .NMU) 

IF(IR.EQ.O)  IR  -=  NMU 
ThET  =  RA0EG*A(;0S(  FMUI  IR  )  ) 

116  wRIT£(6,115)  i  ,  I R . ThET .  ( RTOEOI  I  . J )  . JC  1  , JC2 ) 

1 F ( I DBUG . GT , 1 )  CALL  P2 AR A Y ( R T GEu . NMU . NUMCOL , MXROW , 2 . 

1'  THE  PhI  prime  =  0  Bi-OOS  OF  ThE  EXISTING  RTGEO  ARRAY  J 

CONVERT  The  GEOMETRIC  R  OR  T  ARRAY  BACK  INTO  A  RAY-TALlV  ARRAY 
I  .  E  .  UNDO  9.7 
C 
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DO  120  I R0W= 1 , NUMROW 
:R  =  M0D( IROW, NMU ) 

IF(IR.£0.0)  IR  =  NMU 

FI  =  FL0AT{ NRAQD2 ( 1 R ) ) / ( FMU( IR ) »OMEGA ( IR ) ) 

C  NON-POLAR  QUADS 

DO  121  KU=1,NMU-1 

F2  =  F1*FMU(KU)«0MEGA(KU) 

DO  121  LV=1.NPHI 
JCOL  =  KU  »  (LV-1)»NMU 

121  RTGEOCIROW, jCOL)  =  F 2»RTGEO ( I  ROW . jCOL  I 

C  POLAR  CAPS:  KU  =  NMU 

120  RTGEO( I  ROW , NMU )  =  F 1 • OMEGA ( NMU ) ‘R TGEO I  I  ROW , NMU ) 

NUMRAY  =  NUMRAY  +  NUMRA2 
IMISC(17)  =  NUMRAY 
DO  122  1=1, NMU 

122  NRAYQD(I)  =  NRAYQD(I)  +  NRA0D2(I) 

ENOIF 

WRITE  HEADER  ON  OUTPUT  FIlE 
REWIND  NUOUT 

WRITE(NU0UT  I  NUOuT  , NRAYOO .  1 M I  SC . FM I SL , FMU . PH I  . BNDMU , BNDPHI  . OMEGA . 

1  DELTMU 
C 

RETURN 

C 

C  FORMATS 

C 

100  FORMATClHl,'  natural  HYDROSOL  MODEL.  PROGRAM  2'// 

1'  RAY  tally  and  computation  OF  '.A6,'  FROM  ' , A9 , / / 

IIH  FOR  NMU  NPHI  ='.13.'  WNDSPD  = ' , F8 . 3 , 

2'  M/SEC'//1h  REFR  ='.F7.4) 

no  F0RMAT(1H0,'  for  the  current  run.  NUMRAY  =-,110, 

1 '  total  rays  TRACED'  ) 

112  FORMAT!  IHO,'  THE  r X  I S i  I NG  GEOMETRIC  '.Ab. 

1'  ARRAY  WAS  ACCUMULATED  FROM' /I  10.'  RAYS') 

113  FORMAHImU.'  (SPECULAR)  BlOCK  FOR  PHl  PR  1  ME (  '  , 1 2 .  '  )  =',Fb.l. 

1'  AND  PmI(',I2,  )  =',F6.1,'  OF  THE  EXISTING  '.AB,'  ARRAY'// 

21 7X , ■ column :  ' , lOi 10/ 

333X,'MU(1)  ML:(2)  MU  ( 3 )  MU(4)  MU(5)  MU(6)  M 

4U(7)  MU(8)  MU(9)  MU(IU)'/) 

115  FORMAT!'  R0w',;4,'  MU (  .  I  2 .  '  )  =  '  . Fb ,  1  . 4X ,  10 ( 2X . F8 . 5 )  .  ( / 24X , 

1  10(2X,FB  5  ,  )  ) 

118  FORMAT!  IHO,'  UPf.C'WN  =',Ay.'  ERROR  STOP') 

200  FORMAT!  IhO,'  FIlFS  20  AND  21  INCOMPATIBLE;'/) 

202  FORMAT!  IhO,'  F!,.F  ,13,':  NMU.  NPHI.  WNDSPD  =' 

1// IH  ,  12X , 214 , F  1  .  . 3) 

END 
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c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


t 

c 

c 


c 

C' 


c 


c 


( 


PROGRAM  MAIN( input, OUT PUT, TA PE 5=1NPUT,TAPE6=OUTPUT,TAPE20. 
1  TAPE2 1 , TAPE22 , TAPE23 . TAPE 24 , TAPE25 ) 


♦■  +  +  +  ■♦■  r+  +  +  ^  +  +-  +  +  +  +  +  +-+  +  -»  +  -t'  +  +  +  +  ++  +  -*-+  +  +  +  +  *-f  +  ++  +  +  +  +  -*  +  +  +  +  +  + 


THIS  IS  PROGRAM  2  OF  THE  NATURAL  HVDROSOL  MODEL  + 


■»■+  +  -»■  +  ■*■  H 


t-  +■  +  +  +  +  i 


ON  NHM2/M21QD 

This  program  reaos  an  output  file  written  by  NHMI/MIIQD  and 
TALLEYS  THE  SCATTERED  RAYS  TO  COMPUTE  THE  CORRESPONDING  ROW 
OF  The  geometric  reflectance  or  transmittance  array,  as 

DESCRIBED  IN  SECTION  9. 

This  special  version  of  MAIN2  does  only  one  input  QUAD  (ONE  ROW 
OF  R  OR  T ) , 

I NPUT : 

NEWRUN  =  1,  IF  This  run  starts  from  scratch 

0,  IF  'HIS  IS  A  CONTINUATION  RUN 

TAPE20  =  A  file  of  RAY  DATA  WRITTEN  BY  NHMl/MllQD  AS 
TAPE16.  17,  18,  OR  19 

TAPE21,  IF  NEWRUN  =  0.  THE  FILE  22.  2J.  24,  OR  25  WRITTEN  BY  THE 

PREVIOUS  RUN  OF  NHM2/M210D,  CONTAINING  THE  RTGEO  ARRAY 


OUTPUT ; 

NUOUT  =  The  file  with  the  computed  RTGEO  ARRAY 

NUOUT  =  TAPE22  IF  TAPE20  IS  TAPE16  OF  NHMl/MllUD 

=  TAPE23  ■■  1APE17  "  .  ETC. 

PARAME'^ER  (MXMU-  lU  .  MXPHI  =24  .  MXLOL  =MXMU»  MXPH  I  ) 

COMMON/CMUPHI /  FMU(MXMU) .PHI (MXPHl ) ,OMEGA(MXMU) 

COMMON /CM I  SC/  IMl SC ( 20 ) . FMI SC ( 20 ) 

DIMENSION  RTGEOCMXCOL )  , KNTRAY (MXCOl  ) 

CHARACTER  RTlAB.»6 

INI TIALIZE 

CALL  I N I SHL ( R  TGEw . KNTRa Y , IROW . R 1 lABL , NUOUT ) 

NMU  =  IMISC(  1) 

NPHi  •-  IMISC(2T 
NUMRA  Y  =  I  M  I  SC.  (  I  7  ) 

RADEG  =  FMISC(J) 

NUMCOL  •=  NMU«nPm1 
NR EC  =  0 

READ  AND  ACCUMUiATE  RAY  CONTRIBUTIONS  THIS  IS  THE  SUM  OVER  OMEGA 
IN  9,1,  BUT  WITHOUT  THE  1/S  FACTOR.  THE  SUM  OVER  J  IN  9.1  WAS 
DONE  automatically  AS  TmE  RAv  WAS  TRACED  TO  COMPLETION, 


2UU 


WR  I  TE I  8  ,  102 ) 

READ!  20  ,  LNO^  ZEju  )  1  ,  J  .  K  ,  L  ,  RAD 


NREC  =  NREC  1 

ANY  RAYS  GOING  INTO  A  POLAR 

1  L  =  L 

I F { K . EQ . NMU )  I  =1 
JCU^  =  ^  (i.  L.  -  1)*NMU 

I F ( NRFC .  lE . 25  )  rtR I TE I G .  104 ) 
KNTRAVCjCOL)  -  k?>iT  RA  Y  (  jLOl  ) 
RTGEOCjCOLJ  =  RTGEO! JCOL)  » 


LAP  ARE  STORED  IN  COLUMN  NMU 


NRE  I.  .  I  .  J  .  R  .  I  ,  RAD  ,  JCOL 
•  1 
RAD 


GO  TO  200 


2bU  WR  I  T  E  I  b  .  no  )  NREL 

(. 

C  RIGEU  IS  NOW  proportional  TO  THE  RADIANT  FULX  TRANSFER  FUNCTION 

C 

C  CONVERT  THE  RAV-TALLY  array  INTO  A  GEOMETRIC  R  OR  T  ARRAY  BY  9.7 

C 
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IR  -  MOD( IROW.NMU) 

IF(IR.EQ.O)  IR  =  NMU 
C  NUMRAV  IS  S  OF  9.1 

FACTl  =  FMU(IR)*0MEGA(IR)/FL0AT(NUMRAV) 

DO  252  KU-1,NMU-1 

C  FACT2  CONTAINS  THE  MU  AND  OMEGA  FACTOR  OF  9.7,  AND  1/S  OF  9.1 

FACT?  =  FACT1/(FMU(KU)»0MEGA(KU) ) 

DO  252  LV=1.NPHI 
JCOL  =  KU  »  (LV-1)»NMU 
252  RTGEO(JCOL)  =  FACT2*RTGE0( JCOL) 

C  POLAR  CAP:  KU  =  NMU 

RTGEO(NMU)  -  FACT1*RTGE0(NMU)/0MEGA(NMU) 

RTGEO  IS  NOW  THE  QUAD- AVERAGED  GEOMETRIC  R  OR  T  ARRAY 

PRINTOUT  OF  SELECTED  COLUMNS  NEAR  THE  SPECULAR  DIRECTION 


WRITE(6,112)  IROW.RTLABL. NUMRAV 
IV  =  1 

WRITE (6, 262)  I  V , R ADEG» PH I (  I  V )  .  (RTGEO (JCOL)  , JCOL=l .NMU) 

IS  -  (IROW  -  1)/NMU  V  1 
IV  =  IS  ♦  NPHI/2 
IVl  =  MAXO(2. IV-3) 

IV2  =  MINO(NPHl , IV>3) 

DO  260  IV=IV1 , I V2 
JCI  =  1  +  (IV-1)*NMU 
JC2  =  IV*NMU 

260  WRITE(6,262)  I V . R A  DEG* PH  I ( I V ) . ( R TGEO ( JCOL )  . JCOL  =  JC  1  . JC 2 ) 

C  PRINT  COUNTS  OF  RAYS  CONNECTING  THE  QUADS 

WRITE(6. 112)  IROW, 'KNTRAV , NUMRAY 
IV  =  1 

WRITE(6.272)  IV,RA0EG*PHI(IV).(knTRAy;jC0l),JC0L=1. NMU ) 

IS  =  (IROW  -  1)/NMU  ♦  1 

IV  =  IS  f  NPHI/2 
IV 1  =  MAX0( 2 . I V-3 ) 

IV2  =  MIN0(NPHI  ,  IV-^3) 

DO  270  IV=IVl , I V2 
JCI  =  1  »  (IV-1)‘NMU 

jC2  =  IV*NMU 

270  WRITE (6, 272)  IV,RADEG*PHI(Tv).(KNTkAv(jC0L).JC0L-JC1.JC'2) 

C 

C  COMPUTE  SUM  OVER  U.V  FOR  IRRAD  ChECk 

C 

SUM  =  RTOEC  (  NMU  ) ‘((MEGA  (  NMU  ) 

DO  300  IV=1,NPHI 
DO  300  IU=1.NMU-1 

300  Sum  =  SUM  RTGEOlIU  -  (  I  V  -  1  )  »  NMU  J  *  FMU  (  1  U  )  »OMEGA  (  I  U  ) 

Sum  =  SUM/ ( FMU ( I R ) ‘OMEGA ( I R ) ) 

WRITE(6,302)  SUM 

302  FORMAT!///'  (SUMIU.V)  OF  R T ‘MU ( U 1 ‘uMEGA ( U )  ) / ( MU ( R ) ‘ OMEGA  I R )  ) 
1  IRRAD  REFl/TRANS  = ' . F8 . 6 ) 

C 

C  WRITE  FINAL  ARRA'  TO  OUTPUT  FIIE 

C 

WRITE! NOOuT )  (RTGEO! JCOL )  . JCOt  =  1  . NUM(  (K  ) 

WR  I  T£  (  NuOuT  ;  (  Rr.  ■  R  A  V  (  JCOL  )  .  JC3L  =  1  .  N.jMCOL  ) 

enofile  nuOut 


f‘  ‘jfkM A  T  i 

102  FORMAT ( iHO , '  SE 
1'  Lv  FRESNEl 


ECTEO  RAV  DATA; 
RT  COL'/) 


/  / 


NREC 


I  R 


JS 


KU  ■ 


104  FORMAT! IH 
1  10  FORMAT  1  IHO 
I  1  2  FORMAT (  ImO 

1 ■  array  '  /  / 

32bX . ■ MU ! 1 ) 
4U(  7  ) 

262  FORMAT! 


I  10..JI5,F10.5,I8) 

IB.'  DATA  RECORDS  READ  FROM  UNIT  20') 

'  SEl ECTED  columns  OF  ROw ’ . 1 4 . '  OF  THE 
I  accumulated  FROM',  18.'  INITIAL  RAvS: 
Mul2)  Mi)(3)  MU(4)  MU(5) 

Mu(8)  MU(9)  MU(1U)/) 

ph:  (  ' 


/  / 


MU  (  6  ) 


1 


)  = 


>72  format! 
END 


PHI  1 


,12,') 


F6  1  4X  10( 2X. F8 . 5  )  .  I /24X .  10! 2X , F8 . 5  )  )  ) 
!Fb.l!A,K.lQ(2X,I8),(/24X.iai2X,I8))) 


M 
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subroutine  ini SHLCRTGEO.KNTRAY. IROW.RTL ABL .NUOUT) 

ON  NHM2/IN21QD 

THIS  ROUTINE  INITIALIZES  PROGRAM  NHM2/M21QD 
parameter (MXMU= 10 .MXPHI=24) 

COMMON/CMUPHI /  FMU(MXMU) , PHI (MXPHI ) .OMEGAIMXMU) 

COMMON/ CM I  SC/  I  MI  SC ( 20 ) . FM 1  SC ( 20 ) 

DIMENSION  RTGEOC 1) ,KNTRAY( 1) 

DIMENSION  0NDMU(MXMU) .BNDPHl (MXPHI ) . DELTMU (MXMU ) . NRA YQD ( MXMU ) 
DIMENSION  IMISC2(20) .FMISC2(20) . NR AQ02 (MXMU ) 

CHARACTER  UP00WN»9 . RTLABL *6 . UP0n2»9 . R TL AB2 ♦ 6 

R£AD(5,*)  NEWRUN 

READ  HEADER  RECORDS  OF  RAY  DATA  FILE 
REVglND  20 

READ (20)  NU20,UPOOWN. IR. JS.NRAyOD 

READ{20)  IMISC.FMISC.EMU.PHI .BNDMU . BNDPHl , OMEGA . DELTMU 
C 

NMU  =  I M I  St (  1  ) 

NPHI  =  IMISC(2) 

NUMRAY  =  I  MI  SC (  1  7  ) 

WNDSPD  =  EMI  SC (  1 S  ) 

REFR  =  FMI SC {  la  ) 

NUOUT  =  NU20  b 
lA  =  lAas(IR) 

IF( lA.EQ.NMU)  US  =  1 
IROW  =  lA  »  (JS-1)»NMU 
L 

C  determine  the  type  OF  ARRAY  BEING  PROCESSED 

C 

IF(UPOOWN.EQ.  DOWN  DOWN')  THEN 
RTlABL  -  'T(A,X)' 

ELSEIF (UPDOWN. EQ. ' UP  UP  ')  THEN 
RTLABL  '  T  (  X  .  A  )  ' 

ELSEI F (UPDOWN . EQ DOWN  UP  ')  THEN 
RTLABL  =  'RIA.',)' 

Else  I F ( UPDOWN . EO UP  DOWN')  THEN 
RTLABL  =  '  R ( X  ,  A  )  • 

ELSE 

wR I  re ( fo . 1 la )  updown 

STOP 

ENDIF 

( 

NUMCOL  ^  NMU ‘NPHI 

WR  I  TE  (  b  ,  lOO  )  I  R(J*v  .  R  T  LABL  ,  UPUOWN  ,  NMU  .NPHI  ,  wTTUSPD  .  R  E  F  R  ,  I  R  ,  JS 
NRAQDT  -  NRAVQLH  I  A ) 

WR I TE ( fo . 110)  NRAQDT 
C 

I  F  (NEWRUN  .  EQ  .  1  )  TriEt^ 

C 

c  This  is  a  new  run,  zero  rtgeo  anu  rttikay 

c  ONLY  Those  elements  actuaily  used  ftjp  storage  are  set  tu  zero, 
c  as  an  aid  to  UEBuGGING 

00  MB  J= 1 , NPHI 
do  9H  1=1, NMU  1 
JCOL  =  I  »  (  „  ■  1  I  ‘NMU 

KNTRA/(JCOl)  =  0 
9M  RTGEO(jCOLi  -  0. 

C  POi AR  CAP 

K  N  T  W AY  I  NMU  )  =  0 

M  f  (jEO  (  NMU  )  -  I' 

L 

F,  SF 

C  THIS  IS  A  continuation  Run.  READ  EXISTING  RTGEO 

REWIND  21 

R£AD(21)  NUOU’^2,OPDN2,RTlAB2.IR2,jS2,nRAQD2 
READ! 21)  IMISC2,FMISC2 
NMU2  =  IMI SC2{  I  ) 

NPHI2  =  IMIS C 2(2) 

NUMRA2  =  IMI SC2( 17) 

WN0SP2  =  FMI SC2 ( 15 ) 
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CHECK  FOR  COMPATABLE  FILES 

IF(UPD0WN.NE.UPDN2  .OR.  RTLABL . NE . RTl AB2  OR.  IR.NE.IR2  .OR. 

1  JS.NE.JS2  .OR.  NMU.NE.NMU2  .OR.  NPHI . NE . NPHI 2  .OR. 

2  WNDSPD . NE . WNOSP2  .OR.  NUOUT . NE . NUOUT2 )  THEN 
WRITE(6, 200) 

IFILE  =  20 

WRITE (6, 20 2)  IFILE, UPDOWN, I R . JS . NMu . NPHI , WNDSPD , NUOUT 
IFILE  =  21 

WRITe(6.202)  IFILE, UPDN2 , IR2 . JS2 . NMU 2 .NPHI 2 . WNDSP2 . NUOUT 2 
STOP 
ENDIF 

READ( 21 )  (RTGEO( JCOL ) , JC0L= 1 . NUMCOL ) 

READ( 21)  ( KNTRAV ( jCOL ) . JCOL= 1 . NUMCOL ) 

WRITE(6.112)  IROW , RTLABL , NOMRA2 
DO  114  JC0L= 1 . NUMCOL .  10 

114  WRITE(6.116)  JCOL  .  JCOL*-9,  (RTCiEO(  JCOL»M)  .M=0.9) 

WRITE(6. 112)  IROW, 'KNTRAV ,NOMRA2 
DO  113  JC0L= 1 , NUMCOL .  10 

113  WRITE(6,119)  JCOI _ I  COL  * 9 .  { KNTR A V ( jCOl  »M )  , M  =  0 , 9 ) 

CONVERT  THE  GEOMETRIC  R  OR  T  ARRAy  BACK  INTO  A  RAV-TALlY  ARRAY, 

I . E .  UNDO  9 . 7 

FI  =  FLOAT(NUMRAi  , / (FMU( I  A) *0MEGA( IA(  ) 

DO  120  KU=1.NMU-1 
F2  =  F  I«FMU ( KU ) ‘lMEGA ( KU ) 

DO  120  LV=1,NPHI 
JCOL  =  KU  *  (LYi)»NMU 
120  RTGEO(JCOL)  =  F 2  •  R TGEO ( JCOL ) 

POLAR  CAP;  KU  -  NMU 

RTGEO(NMU)  -  F 1  * OMEGA ( NMU ) ’R T GE  CU  NMU ) 

NRAQOT  :  NRAQD'^  *  ’•".'MRA? 

1MISC(  17)  =  NRACiDT 
ENDIF 

WRITE  header  on  OUTPUT  FILE 
rewind  NUOUT 

WRITE!  NUOuT  )  NUG-v  :  ,  UPDOWN  .RTlABl.IR.JS.  NRACiDT 
WR I T  E ( NUUU  r )  I M I  SC . FMI SC . EMC , Ph!  , BNDMU . BNOPhI  . OMEGA . DEL  TMU 

RETURN 

C  FORMATS 

C 

100  FORMAT! IHl,  NATURAL  HYDROSOL  MOUEl .  PROGRAM  2  (1-OUAD  VERSION)'// 
1'  RAY  TALLY  FOR  COMPUTATION  OF'// 

1  IH  ,'  ROW'.  14,'  OF  '.A6,'  (FROM  .A9.  )  FUR'//1H  ,  NMU  =',13. 

2'  NPHI  WNDSPD  ='.F8.3,'  M/SEC  REFR  =',F7.4// 

31H  .'  the  FIKED  input  QUAD  O(R.S)  WAS  (  '  .  I  2 .  '  .  '  .  I  2 .  '  )  '  ) 

110  FORMAT! IHO,  FOR  THE  CURRENT  RUN,  NRAQOT  =',16) 

112  FORMAT! IHO,'  ROW, 14,'  OF  THE  EXISTING  '.A6.'  ARRAY  ' 

1//1H  (ACCuMUiATED  from. 18,'  initial  RAYS)'/) 

116  F0RMAT(1m  ,  CC-  MNS  ,14,'  TO '  .  ! 4 ,  1 0 i 2X , F 8 . 5 )  ) 

119  F0RMAT!1H  ,'  columns '. 14 ,  ■  TO '  .  I  4 ,  1 0 ( 2X , F B . S  )  ) 

118  FORMAT! IHO,'  UPDOWN  = ' , A9 . '  ERROR  STOP') 

200  FORMAT!  IHO,'  FIlES  2’.T  AND  21  I NCOMPAT  aBi  E  ;  '  /  ) 

202  F0RMAT(1h0.'  f:^E  .13,':  UPDOWN,  IR.  J.  NMU,  NPHI,  WNDSPD,  NU 
lOUT  -'//IM  ,l?x,A9.4I4,ri0.3.I5) 

END 
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4.  PROGRAM  3 

A.  Program  Description 

This  program  reads  the  four  quad-averaged  geometric  reflectance  and  transmittance  arrays 
computed  by  Program  2  (r(a,x)  on  TAPE22,  etc.).  The  corresponding  spectral  arrays  rj(a,x), 
^(a,x),  etc.  are  computed  using  75/5.3  Ic,  75/5.32, 75/5.34,  and  75/5.36.  All  arrays  are  processed 
in  one  run  of  Program  3. 

Recall  that  Programs  1,  2  and  3  are  concerned  only  with  the  air- water  surface  boundary 
conditions.  We  have  so  far  specified  only  the  quad  partitioning  and  the  wind  speed.  The  surface 
boundary  condition  computations  are  thus  completely  independent  of  the  inherent  optical  proper¬ 
ties  of  the  water  body,  of  the  incident  lighting,  etc.  (all  to  be  specified  in  Program  4).  The  output 
from  Program  3  can  therefore  be  run  with  many  different  versions  of  Program  4,  i.e.  with  many 
different  water  bodies.  Only  a  few  runs  of  Programs  1-3  are  necessary  (say  at  two  or  three 
different  wind  speeds)  in  order  to  study  a  wide  range  of  ocean  optics  problems  in  which  the 
water  type,  bottom  boundary  condition,  or  incident  lighting  are  varied. 

B.  Input 

Only  one  user-supplied  input  record  is  required: 

Record  1:  IDBUG 

where  IDBUG  =  0,1,  or  2  as  in  Program  1. 

C.  File  Management 

Program  3  reads  the  four  output  files  from  Program  2  and  creates  one  output  file,  as 
follows: 


symbolic  name 

external  name 

description 

NURAX 

TAPE22 

the  quad-averaged  geometric  r(a,x)  array 

NUTAX 

TAPE23 

the  t(a,x)  array 

NURXA 

TAPE24 

the  r(x,a)  array 

NUTXA 

TAPE25 

the  t(x,a)  array 

NUOUT 

TAPE30 

the  four  spectral  f  and  t  arrays,  written  in  the  order  in 
which  .they  are  needed  in  Program  4,  namely  t(a,x), 
^x,a),  t(x,a),  and  na,x) 

TAPE30  contains  all  of  the  surface  boundary  condition  information  needed  by  Program  4. 
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D.  Code  Listing 


PROGRAM  MAIN(INPUT,0UTPUT.TAPE5=1NPUT.TAPE6=0UTPUT, 

1  TAPE 22 , tape  23 , TAPE  24 , TAPE25 . TAPEOu) 

C 

C  +  +  +  +  -t-+  +  +  +  -t-'f  +  +  +  +  -t-  +  +-  +  -^-t-++-4-  +  +  +  -*--«'-t-  +  ++  »-*-++-*-  +  +  +  -^  +  +  +  +  +  'f-  +  +  +  + 

c  + 

C  this  is  program  3  OF  THE  NATURAL  HVDROSOL  MODEL  + 

C  ♦  ♦ 

L  +  +  +  ■^  +  +  -f  +  +  +  +■  +  +  •f-  +  +  ^  +  -»  +  +  +  +  '*‘  +  +  +  +  -*-  +  »  +  +  v  +  -t--i--*-  +  +  +  +  +  +  -»-  +  +  +  +  +  +  + 

C 

C  ON  NHM3/MAIN3 

C 

C  THIS  PROGRAM  COMPUTES  THE  UPPER  BOUNDARY  SPECTRAL  REFLECTANCE  AND 

C  TRANSMITTANCE  ARRAYS  WHICH  DESCRIBE  THE  AIR-WATER  INTERFACE. 

C  THE  GOVERNING  EQUATIONS  ARE  6.31C  TO  5.36. 

C 

C  THE  ARRAYS  ARE  COMPUTED  IN  THE  ORDER  IN  WHICH  THE  SPECTRAL  ARRAYS 

C  ARE  NEEDED  BY  PROGRAM  4,  NAMELY 

C  THAT(A,X),  RHAT(X.A),  THAT(A.A).  RHAT(A,X) 

C 

C  THE  GEOMETRIC  ARRAYS  ARE  READ  FROM  ThE  OUTPUT  FILES  WHICH 

C  WERE  written  BY  PROGRAM  2  (TAPES  22.  23.  24.  AND  25) 

C 

C  THE  spectral  ARRAYS  ARE  WRITTEN  TO  NuOUT  (TAPE3D) 

C 

C  RThaTI  and  RTHAT2  ARE  EACH  NMU^LNl-^I)  SY  NMU  •  I  NT  (  (  NL  +  2  )  /  2  )  WORDS 

C  THE  STORED  RT  ARRAY  IS  NMU’NPHI/2  BY  NMu*NPHI  WORDS  (THE  TOP  HALF) 

C 

PARAMETER (MXMU- 10 .  MXPHl=24) 

PARAMETER!  I  OR T =M ^Mu ‘MX PH 1  ,  MxNl =MxPHl / 2 ) 

PARAMETER!  I  0  1  HA  T -,MXMU  •  (  MXNL  •  1  )  .  I  02HAT=MXMU*  (  (MXNL+2)/2)  ) 

DIMENSION  R r (  1  DR T  ,  lORT  i 

DIMENSION  R that  1 '  I D IHAT . I D2HAT )  . RThAT2( IDlHAT . ID2HAT) 

COMMON/CPhI/  PhI(MXPhI) 

COMMON /CM  I  SC/  IMI  SC!  20  )  .  FMl  S(  (  2ii ' 

DATA  NURAX  ,  NuTAx,  ,  nuRXA  .  NUTxA/ 22 . 23 , 24 . 25/  .  NU0UT/3U/ 

INITIALIZE  the  Rt'OGRAM 

call  INISHL 
C 

NMU  =  IMISC! 1) 

NPHI  =  IMI SC ( 2 ) 

ID6UG  =  IMISC(9) 

C 

NROWRT  =  NMU*NPhI/2 

ncolrt  =  NMu*NPr(; 

NRHAT  =  IMI SC ! 1 ' ) 

NCHAT  =  IMISC! 1 1 ) 

IPRRT  =  MI  NO ! 20 . NROwRT ) 

IPCRT  =  MINO ( 20 . NCOLRT) 

IPRhAT  =  MI  NO  (  4.,  ,  NRHAT  ) 

IPCHAT  =  MINO  (  20  .  rjCHAT  ) 

I F ( I DBUG . GE . 2 )  uO  TO  888 
C 

c <■  + -n- ■►downward  transm ;  I  tance  t(a.x) 

C  RT  contains  TmE  GEOMETRIC  T  f  A  .  X  ;  R  .  S  . .  V  ) 

C  RThATI  contains  yue  spectral  ThA  T  !  I  a  ,  a  ;  R  .  L /Li  ,  X  ) 

C  RTHAT2  CONTAINS  THE  SPECTRAL  ThAT2 ! A . X : R , L /U . K ) 

C 

C  READ  The  geometric  T!A,X) 

r 

READI  NUTAX  )  NUNI T 
iF(NUNIT.EO.NOTAX)  THEN 

wRirE(fa,70U)  ThATUA.X)  .  Thai  2!  a, X)  ,  IIA.X)- 

Else 

WR  I  TE  (  b  ,  702  )  N  jr<  I  T  ,  ’NUTAX  '  .NuTAx. 

STOP 
ENOI  F 
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DO  710  J-l.NCOLRT 

710  READ(NUTAX)  ( R T ( 1  ,  J  )  .  1  =  1 , NROWRT ) 

DEFINE  A  FULL  RT  ARRAY  TO  AVOID  SPECIAL  INDEXING  IN  RTSPEC 
CALL  FUlLRTCRT .NMU.NPMI , IDRT) 

CALL  P2ARAY (RT ,  I PRRT . I  PORT . IDRT . 2 .  ' GEOMETRIC  T AX ( R . S / U , V )  '  ) 
COMPUTE  TMAT(A.X) 

CALL  RTSPEC ( PHI , RT . IDRT ,  RTHAT 1 . R THAT 2 . I D IHAT ) 

WRITE  THE  spectral  ARRAYS  TO  FILE  NUOUT 
00  221  J=1.NCHAT 

221  WRITE(NUOUT)  ( RTHA T  1  ( I  . J )  . I  =  1  . NRhA T ) 

DO  222  J= 1 . NCHAT 

222  WRITE(NUOUT)  ( RTHA T 2 ( I , J ) , I = 1 . NRmA T ) 

CALL  P2ARAY ( RTHAT 1 , I PRHAT , I PCHA T . I D IHA r , 2 , ■ AMP  ARRAY  THATl(A.X)') 
CALL  P2ARAY ( RTHAT 2 , I PRHAT . I PChAT . lOlHAT . 2 . ■ AMP  ARRAY  THAT2(A.X)') 

♦  ttUPWARD  reflectance  R{X.A) 

RT  CONTAINS  THE  GEOMETRIC  H ( X . A . R , i . u . V ) 

RIHATl  CONTAINS  THE  SPECTRAL  RmA I  1 ( X . A ; R . L / U . K ) 

RTHAT2  CONTAINS  TmE  SPECTRAL  RhA I  2 ( X . A ; R . L / U , K ) 

READ  The  geometric  R(X,A) 

R£AO( NURXA )  NUNI T 
I F ( NUN  I T . EQ . NURXA  )  THEN 

WRirE(6.7U0)  'RMATKX.A)  -  .  •RllAT2(X.Ai  .  RIX.A)' 

else 

WRITE(0.702)  nun  I  I  .  • NURXA ■  . NURaA 

STOP 

ENDIF 

DO  72U  J=:1,NC0LRI 

720  READ(NURXA)  C RT (  I  , J )  ,  I  =  1  . NROWRT ) 
call  FuLLRT ( RT , NMu . NPHI  ,  I  dr T ) 

CALL  P2ARAY ( RT , I PRRT . I PCRT . IDRT . 2 .  GCUMETRIC  RXA ( R , S / U , V ) ' ) 
compute  RHAT(X.A) 

CAl^.  R  TSPEC  (  Phi  ,  R  i  ,  I  URT  .  RlHA  I  1  ,  R  I  HA  I  .  I  IMHA  1  ) 

DO  211  J-1,NLHAI 

211  WRITE(NUOUT)  (  R  1  n  A  T  1(  I  .  J  )  .  I  ^  1  .  tlRHA  1) 

DO  212  J=l, NCHAT 

212  WRITEINUOUT)  ( R ThA T 2 ( I , J ) . I = 1 . NRHA T ) 

call  P2ARA  Y  (  R  THA  I  1  ,  I  PRHA  T  .  I  P(_HA  T  .  1  D  ItlA  T  .  2  .  AMP  ARRAY  RHAT1(X,A)  ) 
CALL  P2ARAY ( R THA T2 , I PRHA T . 1 PChA I . I D iHA T , 2 . • AMP  ARRAY  RHAT2(X,A)) 

ti- I  t- t(;RwARD  TRANSMI  r  r  AN(  E  T(X.A) 

RT  CONTAINS  THE  GEOMETRIC  T ( x . A ; R . S ; U . V ) 

RIHATl  CONTAINS  TmE  SPECTRAL  I  HA  I  1  ( X . A ; R . L / U , K ) 

RTHAT2  CONTAINS  THE  SPECTRAl  T mA T 2 ( X , A ; R . L / U , X ) 

READ  THE  GEOMETRIC,  T(X,A) 

READ(NuTXA)  NUNIT 
I F  { NUNI T  ,  EO . NU rxA  )  THEN 

WRITE(b,700)  'THATl(X.A)' , •THA'2(X.A)',  T(X,A)' 

ELSE 

WRI iL(b, 702)  NUNIT,  NUTXA' .NjTxA 
S  TOP 

ENDIF 

DO  7.10  .)-l.N(,OLRI 

7,30  READINUT/A)  (  R  T  (  I  ,  J  )  ,  I  -  1  .  NROWP  T  ) 
call  F  UL  1  R  T  (  R  I  ,  IiMu  .  NPHI  .  I  DR  f  ) 

CA,,  L  P2ARA  V  (  R  T  ,  1  PRRT  ,  I  PCIR  T  ,  1  DR  1  ,  ,  lil  OME  T  R  I  (  T  XA  (  R  ,  S/U  ,  V  )  '  ) 

C 

C  COMPUTE  that (  X  . a  ) 

call  r t spec ( pm  I , r r , I  dr t ,  rtma t i . r i ha i 2 , i d  iha t ) 

c 
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DO  231  J=1.NCmAT 

231  WRITECNUOUT)  ( R THA T 1 { I . J j , I = 1 . NRHA 7 ) 

DO  232  J=1,NCHAT 

232  WRITciNUOUT)  ( R THAT  2 ( I  , J j  .  1  =  1 . NRHA7 ) 

CALL  P2ARAV(RTMAT1  .  IPflMAT.  IPCHAT,  r01HA'r,2,  'AMP  ARRAV  THATKX.A)') 
call  P2ARAY (RTHAT2 , I PRriAT . I PChaT . I DImAT . 2 . ■ amp  ARRAV  TMAT2(X.A)') 

-f>  +  »»DOWNWARD  reflectance  R(A.X) 

RT  CONTAINS  THE  GEOMETRIC  fl ( A . X . R . S ; U . V ) 

RTHATl  CONTAINS  THE  SPECTRAL  RHAT 1 ( A . X ; R , L / U , K ) 

RTHAT2  CONTAINS  THE  SPECTRAL  RHA T2 ( A . X ; R . L / U . K ) 

aaa  continue 

READ  THE  GEOMETRIC  R(A.X) 

READ(NURAX)  NUNIT 
I F ( NUNI T . EO . NURAX)  THEN 

WRITE(6.700)  ' RHATl ( A .X ) ' . ' RHAT2( A .X)'.'R(A,X)' 

else 

WRITE(6,702)  NUN  I T ,  ' NUR AX '  , NUR AX 

STOP 

ENDI  F 

DO  740  J=1,NC0LRT 

740  READ(NURAX)  ( RT ( I . J ) . I = 1 , NROWRT ) 

CALL  FULLRTIRT , NMU . NPHI . IDRT ) 

CALL  P2ARAy (RT , I PRRT , I PCRT . IDRT , 2 .  GEOMETRIC  R AX ( R . S / U , V ) ' ) 
COMPUTE  RHAT(A,X) 

CALL  RTSPEC ( PHI , R r , I DRT ,  RTHA7 1 . RTHA T 2 . 1 D IHA 1 ) 

DO  201  J=1.NCHAT 

201  WRITE(NUOUT)  ( R ThA T 1 { I , J ) . I = 1 . NRhA T ) 

DO  202  J=1,NCHAT 

202  WRITE(NUOUT)  (  R  ThA  T  2  (  I  ,  J  )  .  I  1  .  NRha  T  ) 

call  P2ARAV  (RT^A 1  ,  I  PRhAT  .  I  PCnAT  ,  lOlHAT  ,  2  .  •  amp  ARRAV  RHAT1(A,X)') 
call  P2ARAV IRTHA T2 , I PRHAT . 1 PCHAT , lOlHAT , 2 . ■ amp  ARRAV  RhAT2(A,X)') 

ENDFIlE  NUOUT 
WRITE(6.750)  NuOuT 
C 

C  FORMATS 

C 

700  F0RMAT(1H1,'  NOv.  COMPUTING  '.AID,  AND  ',A]0,'  FROM  ’.AE) 

702  FORMATIIHO,'  ERROR;  NUNI T  -'.la,'  AND  ’.Ab.'  =',I3) 

750  format; IHO,'  normal  EXIT  FROM  PROGRAM  3.  TAPE'. 13.'  WRITTEN') 

END 
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subroutine  INISHL 

c 

c  ON  NHM3/1NISHL3 

C 

C  this  rouine  initializes  program  3 

c 

parameter  (MXMU=10,  MXPHI=24) 

DIMENSION  FMU(MXMU) ,BNDMU(MXMU) .BNDPMI (MXPMI ) , 

1  OM£GA(MXMU) .D£LTMU(MXMU) 

COMMON/CPHI/  PHI(MXPHI) 

COMMON/CMI SC/  IMISCCZO) .FMISCIZQ) 

DATA  NURAX/22/,  NUOUT/30/ 

C 

REA0(5.*)  IDBUG 
C 

C  READ  header  RECORD  OF  ONE  OF  THE  GEOMETRIC  ARRAYS 

C 

REWIND  NURAX 

READ(NURAX)  nun  I  T , NRAYOO . I M I  SC . FM I  SC . FMU . PH 1  . BNDMU . BNDPHI  . OMEGA . 

1  DELTMU 
REWIND  NURAX 

C 

NMU  =  IMISCI I ) 

NPHI  =  IMISC(2) 

NL  =  NPHI/2 
IMISC(3)  =  NL 
1M^SC^^  ')  -  i  DBUG 
NRhAT  =  nMu*  CNL‘  1 ) 

IMI SCI iO)  -  NRHAT 
NCHAT  =  NMU* ( ( NL» 2 ) /2) 

JMI SC ( 11 )  =  NCHAT 

WNDSPO  -  FMI SC ( IS ) 

REFR  =  FMISC'I  18) 

C 

wfl  I  re  (  6 . 300  i  NMtJ  .  NPHI  ,  NL  ,  WNOSPO.  REFR 
C 

C  WRITE  HEADER  RECORDS  ON  OUTPUT  FUE 

C 

REWIND  NUOUT 

WRITE! NUOUT )  NUOuT . I M I  SC . F M I  SC , FMU , PH 1  , BNDMU . BNDPHI  , OMEGA , DECTMU 
C 

C  FORMATS 

c 

300  FORMAT! IHl,-  PROGRAM  3  OF  The  NATURAL  HYDROSOC  MODEL// 

IIHO.'  COMPi  ITA'^  I  ON  OF  UPPER  BOUNDARY  SPECTRAL  REFLECTANCE  AND  TRANS 
2MITTANCE  ARRAVS'///1H  NMU  ='.I3//1H  NPHI  =',I3//1H  , 

3'  NL  ^'.la/ZlH  .•  WNDSPO  ^-.F/.O/ZIH  ,•  REFR  ,  F  b  .  3  ) 

END 
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subroutine  FULLRT (RT , NMU .NPHl , lORT) 

ON  NMM3/FULLRT 

THIS  ROUTINE  CREATES  A  FULL  (SQUARE)  GEOMETRIC  R  OR  T  ARRAY  FROM 
the  "TOP  HALF"  DESCRIBED  IN  SECTION  12B.  USE  OF  THE  FULL  ARRAY 
MEANS  that  no  SPECIAL  INDEXING  CALCULATIONS  (SEE  PAGE  191)  NEED 
TO  BE  DONE 

DIMENSION  RT( IDRT ,  1) 

NFULL  =  NMU*NPHI 
NHALF  =  NFULL/2 
DO  100  IROW  =  NHALF*- 1  ,  NFULL 
DO  102  JCOl=1. NHALF 

102  RT(  IROW,  JCOL)  =  R  T  (  I  ROW-NHA  L  F  .  JCOl  NHALF  ) 

DO  100  JC0L=NHALF» 1 .NFULL 
100  RT( IROW. JCOL )  =  RT(  I ROw-NHALF . JCOL  -NHAlF ) 

RESET  THE  POLAR  CAP  OUTPUT  FOR  THE  BOTTOM  HALF  (ZERO  VALUES 
CAME  FROM  the  B  BLOCK,  SEE  PAGE  190) 

DO  110  irow=nhalf» 1 .nfull 
liu  RT  (.  I  ROW  ,  NMU  )  -  H  T  (  I  ROw-NHAlF  .  NMU  ) 

RE-ZERO  The  polar  CAP  OUTPuT  COLUMN  AI  PHI  =  180.  WHICH  HAS 
PICKED  UP  NON-ZtHO  values  from  iHt  A'BLOCK 

JCOL  =  NMU  +  NHAlF 
00  104  IR0W=1.NFulL 
104  RT( IROW, JCOL  )  =  0. 

C 

RETURN 

END 


SUBROUTINE  R TSPLC ( PHI , RT , 1 DRI  RThATI  RTHAT2  IDIHAI) 

C 

C  ON  NHM3/RTSPF.C 

C 

C  THIS  ROUTINE  FIRST  COMPUTES  THE  SPECTRAL  AMPLITUDES  FROM  THE 

C  VARIOUS  special  CASES.  5.31C  TO  5 . 3t .  GIVEN  RT  =  R  OR  T  IN 

C  GEOMETRIC  FORM. 

C 

C  The  amplitudes  RTHATI  -  RhAT 1  OR  THATl  AND  RTHAT2  =  RHAT2  OR  THAT2. 

C  ARE  STORED  ON  THE  COMPRESSED  SPECTRAL  ARRAY  FORMAT  OF  (12  4) 

C 

C  The  spectral  amplitudes  are  then  checked  using  RAYLEIGH'S  EQUALITY  4  17 
C 

C  FINALLY.  The  MATRIX  ELEMENTS  DEFINED  BY  (5.41)  AND  (5.43)  ARE 

C  COMPUTED  FROM  THE  ARRAYS  OF  AMPLITUDES. 

C 

c  N.e,  IN  This  routine,  k  and  l  are  reversed  from  the  notation 
C  USED  in  the  tech  REPORT  ERl-PMEl-75. 

c 

DIMENSION  PHl(l),  RT(IDRT,1).  R THA T 1 ( 1 0 IHA T , 1 ) , R THA T 2 ( 1 D IHAT , 1 ) 
COMMON/CMI SC/  IMISC(20) 

C 
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NMU  =  IMISCC 1) 

NPMI  =  IMISC(2) 

NL  =  IMISCO) 

IDBUG  =  IMISCO) 

NRHAT  =  IMISC(IO) 

NCMAT  =  IMISC(H) 

C 

DO  100  K=0.NL 
AK  =  FLOAT(K) 

IF(K.EQ.O  .OR.  K.EQ.NL)  THEN 
EPSK  =  FL0AT(NPh1 ) 

ELSE 

EPSK  =  FLOAT(NL) 

ENOIF 

C 

DO  100  L=0,NL 

SKIP  THE  computation  IF  (K  L)  IS  ODD 
IF (MODI K»L , 2 ) ■ NE . 0)  GO  TO  100 

AL  =  FlOAT(L) 

if(l.eq.o  .or.  l.eq.nl)  then 

EPSL  =  FLOAT(NPHI) 

ELSE 

EPSl  =  FLOAT(NL) 

ENDIF 

00  102  IR^l.NMU 
DO  102  1U=1.NMU 

STORAGE  INDICES  FOR  SPECTRAL  ARRAYS 
lUS  =  NMU*L  ♦  IR 

IVS  =  NMU*K  +  lU  -  NMU»((K+L)/2  -  L/2) 

IFdR.LT.NMU  .AND.  lU.LT.NMU)  THEN 

GENERAL  CASE;  INPUT  QUAD  IS  NONPOLAR.  OUTPUT  QUAD  IS  NONPOLAR;  USE  5.31C 

SUM!  =  0. 

SUM2  -  0. 

DO  204  IS=1.NPHI 
COSLPS  =  COS( Au *PHl ( IS) ) 

SINLPS  =  SIN( AL»PHI ( I S) ) 

IROW  =  NMU* (  I S-  1  )  *  IR 
DO  204  IY=1,NPHI 

SUMl  =  SUMl  *  RT ( IROW . NMU* ( I  V- 1 ) *IU) ♦COSLPS*COS( AK*PHI  (  I  V )  ) 

204  SUM2  =  SUM2  +  R T ( I  ROW , NMU* ( I  V- 1 ) *  I U ) ♦ S I N L PS ♦ S I N ( A K *  PH I  ( I  V )  ) 

RTHATK lUS. IVS)  =  SUMl/(ePSL*EPSK) 

IF(L.EQ.0  .or.  l.eq.nl  .OR.  K.EQ.O  .OR.  K.EQ.NL)  THEN 
RTHAT2( lUS. I VS)  -  0. 

ELSE 

RTHAT2{ lUS, IVS)  =  SUM2 /( EPSL * EPSK ) 

ENDIF 

special  cases  FOR  THE  POLAR  CAPS 
ELSEI F ( IR . EQ . NMU  .AND.  I U . L T . NMU )  THEN 

INPUT  QUAD  IS  The  POLAR  QUAD.  OUTPUT  IS  NONPOLAR;  USE  Ei.J2 

IRT  =  NMU 
IF(l.eq.O)  Then 
SUMl  =  0. 

DO  200  I  V- 1  , NPHI 

200  SUMl  =  SUMl  »  RT ( I RT . NMU* (  1 V  1 1 t lu) ♦COS( AK*PHI  (  I  V )  ) 

RTHAT 1 ( I  US .  I vS )  =  SUMl/EPSK 

RThAT2( IUS. I vS)  =  0. 

ELSE 

RTHAT  UIUS.IVS)  =  0. 

RTHAT2 ( I uS , I vS )  =  0 . 

ENDIF 
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ELSEI F ( I R . LT . NMU  .AND.  IJ . EQ . NMU )  THEN 
C 

C  INPUT  QUAD  IN  nonpolar,  OUTPUT  QuAD  IN  THE  POLAR  CAP;  USE  5.34 

C 

JRT  =  NMU 
IFIK.EQ.O)  then 
SUMl  =  0. 

DO  202  IS=1,NPHI 

202  SUMl  =  SUMl  +  RT (NMU* ( I S- 1 )+ IR . JRT ) •COS( AL»PHI ( I S ) ) 

RTHATK  lUS,  IVS)  SUMl/EPSL 
RTHAT2(IUS, IVS)  =  0. 

Else 

rthat 1 ( I  us . I  vs  )  =  0  . 

RThAT2( lUS, IVS)  =  0. 

ENDI  F 

c 

ELSEI F ( IR . EO . NMu  .AND.  I U . EQ . NMl j  IhEN 
C 

C  INPUT  QUAD  IS  ThfE  POLAR  CAP.  OuTPuT  OoAD  IS  THE  POLAR  CAP;  USE  5.36 

C 

if(k.eo.o  .and.  l.eq.o)  then 

RTHATK lUS, IVS)  =  RT(NMU,NMU) 

RThAT2(IUS. IVS)  ^  0. 

ELSE 

rthat  1  (  lUS  ,  IVS ')  =  0. 

RTMAT2( lUS. IVS)  =  0. 

ENDI  F 
C 

ENDI  F 
C 

102  continue 

100  CONTINjE 
C 

C  CHECK  HE  computed  SPECTRAL  AMFlIIuDE.-, 

C 

I F ( I DBUG . NE . 0  )  Then 
IPRMAT  =  40 
IP;.HAT  =  20 

call  P2AR a Y ( R  ThA  T 1  ,  [ PRhA  T ,  I PChA  T .  I D IHA  T , 2 . 

1'  THE  spectral  amplitudes  RThAT;  ) 

call  P2ARAV(R'hAT2.1 PRHAT .  I PCHA i  .  I  0 IMAT . 2 , 

1’  THE  spectra,  amplitudes  RTHAT2  ) 

call  SPEChK(RT.1DRT,RTHAT1,RTHAT2.1D1hAT) 

ENDI  F 

C  CONVERT  the  spectral  AMPLITUDES  TO  THE  SPECTRAL  ARRAYS  DEFINED  BY 

C  5.41  and  5.43.  the  array  ELEMENTS  ARE  THE  AMPLITUDES 

C  multiplied  By  factors  of  1.  Nl  OR  NPHI.  AS  SEEN  IN  TABLES  1  AND  2 

C  ON  PAGES  90  AND  9 1  . 

C 

EPSL  -  FLOAT(NPHI ) 

DO  300  IROW=l,NMU-l 
DO  300  JCOL=l .nlhaT 

300  rthat 1( IROW . J' UL )  =  EPSl ‘RTHAT I ( [ Rua . jCOL I 

C 

EPSL  =  FLOAT ( N.  ) 

DO  302  I  RCW-n:-'  )♦  1  ,  NRr-iAT -NMU 
DO  302  jCOl^I.nChaT 

RTHAT  1  (  I  ROW  ,  jCOL  )  -  £PSL*RThAT  K  IROY,  ,  JLUl  ) 

3i)2  RTHAT2(  IROw,  jCOl  )  =  £  pSl  ‘  R  tha  7  ;  ROw  .  ji.OL  ) 

C 

EPSL  =  Float : nphi j 

DO  304  IROW=NRhaT-nMU‘ 1 .nRhAT - J 
DO  304  jCOl-'.  NChAI 

304  RTHAY  1  (  I  ROW  ,  J  TlL  ,  =  E  PSu  *  R  ^hA  T  i  ,  ;  ;  L  Sl  ) 

C 

return 

END 
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SUBROUTINE  SPECMK(RT,IDRT,RTmAT1 . RTHAT2 , IDIHAT ) 

ON  NHM3/SPECHK 

THIS  ROUTINE  CHECKS  THE  COMPUTED  SPECTRAL  R  AND  T  AMPLITUDES 

BY  SEEING  IF  the  WEIGHTED  SUM  OF  THE  SPECTRAL  AMPLITUDES  SQUARED  EQUALS 

the  SUM  OF  THE  GEOMETRIC  ELEMENTS  SQUARED  (RAYLEIGH’S  EQUALITY,  4.17) 

THIS  CHECK  HOLDS  ONLY  FOR  NON-POLAR  QUADS. 

PARAMETER(MXMU=1Q)  ,  ^  ^  , 

dimension  RTCIDRT.D.RTHATK IDIHAT ,1).RTHAT2(ID1HAT,1) 

DIMENSION  GEOSUM(MXMU ,MXMU) . SPC SUM ( MXMU . MXMU ) 

COMMON/CMI SC/  IMISC(20) 

NMU  =  IMISC(l) 

NPHI  =  IMISC(2) 

NL  =  IMISCO) 

NRTGEO  =  NMU*NPmI 

DO  100  1=1, NMU- 1 
DO  100  J=1,NMU-1 

COMPUTE  The  Sum  of  squares  of  the  geometric  array  elements 
SUM  =  0. 

DO  110  1 ROW= I , NP TGEO . NMU 
DO  110  ICOL.  =  J  .NRTGEO. NMU 
110  SUM  =  Sum  RT(  IROW,  ICOl)  **2 
GEOSUMd.J)  =  SUM 

IFII.EQ.NMU  .and.  J.EQ.NMU)  WRITEC6.333)  RT(I,J) 

333  FORMATClH  R T ( NMU . NMU )  = '  . F  10 . S ) 

COMPUTE  THE  WEIGHTED  SUM  OF  SQUARES  OF  THE  SPECTRAL  AMPLITUDES. 

THE  amplitudes  ARE  STORED  ON  THE  ARRAY  FORMAT  OF  (12.4). 

SUM  =  0. 

DO  120  K=O.NL 

IF(K.EQ.O  .OR.  k.EQ.nl)  Then 
EPSK  =  FlOAT(NFHI) 

GAMk  =  0. 

Else 

EPSK  =  FLOAT(Nl) 

GAMK  =  FlOAT(NLJ 
ENDI  F 

DO  120  L=0,NL 

I F ( MOD( K  + L , 2 )  . NE . 0  )  GO  TO  120 

IF(L.Ea.O  .OR.  l.EQ.NLI  then 
EP5L  =  FLOA  T ( NPHI  ) 

GAML  =  0. 

else 

EPSL  =  plOAT(NL; 

GAMl  =  F  lOAT ( NL  ) 

ENOI  F 

COMPUTE  ROW  and  column  INDICES  OF  THE  COMPRESSED  AMPLITUDE  ARRAYS, 
arrays ,  BY  ( 12 . b ) 


I ROVV  -  I  *  NMu  * 

ICOL.  =  J  *  -  NMU*  (  (  *<+ L  )  /  ; 


K  /  J  ) 


SUM  =  SUM  EPSK  *  EPSL*RTHAT  1  (  IRi,.-.  .  I  CCl  )  » 

I  GAMk''GAMl»RThAT2(IROW.ICOl)**2 

i2D  continue 


SPC SUM ( I , J )  =  SUM 

100  CONTINUE 

call  P2AR4 Yl GEOSUM , NMU- 1 . NMU- 1 , M»MU . 2 , 
i'SUMS  OF  SQUARES  OF  THE  NON-POlAR  GEOMETRIC  R/T  ARRAY  ELEMENTS  ) 
call  P2ARAY ( SPCSuM , NMU- 1 , NMU- 1 ,MXMU . 2 . 

1  RAYLEIGH  SUMS  OF  SQUARES  OF  The  nON-POLAR  SPECTRAL  R/T  AMPLITUDES 

2  '  / 

RETURN 

ENU 
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5.  PROGRAM  4 

A.  Program  Description 

This  program  performs  the  remaining  initialization  steps  of  75/7a.3-7a.5  and  then  as¬ 
sembles  the  solution  amplitudes  as  described  in  75/§7b.  The  internal  structure  of  Program  4  is 
essentially  that  shown  in  75/Fig.  7.  This  program  is  the  other  main  consumer  of  computer  power 
in  the  NHM,  owing  to  the  discretization  of  the  phase  function. 

It  is  usually  convenient  to  run  Program  4  in  two  different  modes.  In  the  first  mode 
(ICPHAS  0  in  record  3,  below),  the  program  computes  and  stores  the  quad-averaged  phase 
function  as  described  in  75/§I  1 .  These  calculations  can  be  very  expensive  if  the  phase  function 
is  highly  peaked  in  the  forwiu-d  direction,  as  is  the  case  in  natural  waters.  However,  these 
calculations  need  be  done  only  once  for  a  given  phase  function  (and  a  given  quad  partition).  In 
the  second  mode  (ICPHAS  =  0  in  record  3),  it  is  assumed  that  the  phase  function  has  already 
been  discretized;  the  file  containing  this  information  is  read  and  the  radiance  amplitudes  are  then 
computed.  In  the  case  of  a  spherically  symmetric  phase  function,  which  may  be  of  interest  for 
comparison  purposes,  the  discretization  calculations  are  trivial.  In  this  case,  it  may  be  convenient 
to  run  Program  4  to  completion  each  time  (i  e.  both  modes  1  and  2);  the  discretized  spherical 
phase  function  is  not  worth  saving. 

B.  Input 

Two  more  parameters,  uiiich  detemiine  ma.ximum  array  dimensions,  must  be  set  at  com¬ 
pilation  time.  These  parameters  are  (see  the  first  PARAMETER  statement  in  MAIN). 


parameter 

value  in  listed  code 

definition 

MXY 

30 

the  maximum  number  of  optical  depths  yj, 
j=l,  -.YOUT,  at  which  the  final  output  is 

desired  (see  75/Fig.  6) 

.MXSIGY 

7 

the  maximum  number  of  optical  depths  y^, 
i=l,  -,YOP.  at  which  the  inherent  optical 
properties  are  specified  (see  75/Fig.  6) 

Referring  to  75/page.s  132  135,  MXY  gives  the  maximum  allowed  value  of  YOUT  and 
MX.SIGY  gives  the  rnaxim.um  allowed  a'ue  of  YOP. 

.Six  free-format  data  rec(  'd-  are  read  at  execution  time,  as  follows. 

RetH)rd  1 :  ITITI.E 

This  is  an  alphanumeric  title  for  the  run,  used  to  identify  the  printout.  Up  to  80  characters 
are  allowed. 
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Record  2:  IDBUG,  WAVENM,  ABSORB 

IDBUG  =0, 1 ,  or  2,  as  in  Program  1 

WAVENM  is  the  wavelength  in  nanometers  of  the  monochromatic  radiance.  This 
wavelength  is  used  in  subroutine  PHASER  (see  the  version  for  the 
Pelagos  Sea  in  the  code  listing)  to  select  the  correct  wavelength  depend¬ 
ent  absorption  and  scattering  functions. 

In  the  listed  code,  WAVENM  must  be  one  of  the  13  wavelengths  400.0, 
425.0, ■••,675.0,  700.0,  although  this  is  not  a  restriction  of  the  NHM 
algorithms. 

ABSORB  If  ABSORB  <  0.0,  then  the  value  of  the  absorption  coefficient  returned  by 
PHASEF  is  used. 

If  ABSORB  >  0.0,  then  the  absorption  coefficient  is  set  to  ABSORB.  This 
overrides  the  value  returned  by  PHASEF.  (This  is  useful  for  studies  in 
which  only  the  scattering-to-absorption  ratio  changes.) 

Record  3:  ICPHAS,  NUQB,  NVQB,  INCBAS 

This  record  gives  information  for  the  discretization  of  the  phase  function. 

ICPHAS  =0  if  the  phase  function  has  already  been  discretized  in  a  previous  run  of 
Program  4.  File  NUPHAS  will  be  read. 

0  if  this  run  is  to  discretize  the  phase  function. 

If  ICPHAS  <  0,  the  run  stops  after  file  NUPHAS  has  been  written. 

If  ICPHAS  >  0,  the  run  discretizes  the  phase  function,  writes  file 
NUPHAS,  and  continues  with  the  amplitude  computations. 

NUQB  the  value  of  njj^  in  75/1 1.3.  A  value  of  1  can  be  used  for  a  spherically 

symmetric  phfee  function.  Use  NUQB  =  3  or  4  for  the  quad  resolu¬ 
tion  of  75/Fig.  4a  or  4b  and  phase  functions  typical  of  natural  waters. 

the  value  of  n^jj  in  75/1 1.3.  Use  values  like  those  for  NUQB. 

the  factor  for  increasing  the  base  numbers  of  subcells  (n^  and  n^)  in 
75/11.3,  for  quad  pairs  which  involve  forward  (or  n^  forward) 
scattering.  A  value  of  10  is  reasonable  for  natural  waters  (use  1  if  the 
phase  function  is  spherically  symmetric).  If  NUQB  =  3  and 
INCBAS  =  10,  say,  then  in  75/1 1.3,  n^  is  increased  to  30  for  quads 
involving  forward  scattering.  This  gi\^s  a  more  accurate  evaluation 
of  75/1 1.1. 

Record  4:  IBOTM,  RFLBOT 

This  record  specifies  the  bottom  boundary  condition. 

IBOTM  =0  if  the  bottom  is  to  be  a  matte  surface  at  a  finite  depth.  The  surface 
has  a  reflectance  of  r.  =  RFLBOT  (see  75/3.26) 


NVQB 

INCBAS 
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=  1  if  the  bottom  is  infinitely  deep,  and  the  water  is  homogeneous  below 
depth  z  (see  75/§10). 

RFLBOT  The  bottom  reflectance  (used  only  if  IBOTM  =  0).  0.0  <  RFLBOT  < 

1.0. 

Record  5:  lYOP,  NY,  YOUT(l), •••,YOUT(NY) 

This  record  specifies  the  depths  at  which  output  is  desired. 


lYOP 


NY 


=  0  if  the  YOUT  values  as  read  are  geometric  depths  in  meters  (in  the 
listed  code,  this  option  is  available  only  for  attenuation  functions 
which  are  independent  of  depth). 

=  1  if  the  YOUT  values  as  read  are  optical  depths  (this  option  is  valid  for 
inhomogeneous  waters). 

the  number  of  y-levels  where  output  is  required  (NY  is  YOUT  in 
75/Fig.  6.  NY<MXY). 


YOUT(l)  the  depths  where  output  is  desired.  Always  set  YOUT(l)  =  0.0  =  x. 

:  The  alue  of  YOUT(NY)  is  z  (see  75/Fig.  6). 

YOUT(NY) 


A  convenient  set  of  optical  depths  for  printout  in  infinitely  deep  water,  homogeneous 
below  z  =  20.0  optical  depths,  might  be 

0.0, 0.5,  1.0.  2.0,  5.0,  10.0,  15.0,  and  20.0. 

Here  YOUT(l)  h  x  =  0.0,  YOUT(2)  =  0.5,  -,YOUT(NY)  s  z  =  20.0,  with  NY  =  8.  See  input 
records  3  and  5  of  Program  5  for  special  choices  of  y-  =  YOUT(j)  which  are  often  convenient  for 
checking  the  results,  computing  K-functions,  etc. 


Record  6:  RSKY,  CARD,  SHTOTL,  THETAS,  PHIS 

This  record  specifies  the  incident  (sky  +  sun)  radiance  distribution,  using  the  model 
described  in  Appendix  B. 


RSKY 

The  raao  of  sky  to  total  (sky  +  sun)  input  scalar  irradiance;  0.0  < 
RSKY  <  1,0.  RSKY  =  0.0  for  a  black  sky  (sun  only);  RSKY  =  1.0 
for  a  background  sky  only  (no  sun). 

CARD 

The  cardioidal  parameter  for  the  sky  radiance  distribution  (see 
Appendix  B  of  this  report);  CARD  =  0.0  for  a  uniform  sky;  CARD  = 
2.0  tor  a  cardioidal  sky. 

SHTOTL 

The  total  (sky  +  sun)  spectral  scalar  irradiance  on  the  water  surface  at 
the  given  wavelength,  in  W  m'^  nm  ’. 

THETAS 

The  polar  angle,  0  ,  in  degrees  of  the  sun’s  location  in  the  sky. 
THETAS  =  0.0  for  the  sun  at  the  zenith;  THETAS  =  90.0  for  the  sun 

at  the  horizon. 
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PHIS  The  azimuthal  angle,  <))^,  in  degrees  of  the  sun’s  location,  measured 

counterclockwise  from  =  0.0  in  the  downwind  direction  (e.g. 
PHIS  =  90.0  places  the  sun  in  the  crosswind  direction). 

In  addition  to  the  above  data  records,  the  user  must  make  sure  that  the  desired  version  of 
subroutine  PHASE?  is  being  used.  This  routine  specifies  the  inherent  optical  properties  of  the 
water  body.  Four  versions  of  PHASEF  are  listed  in  this  report.  Two  of  these  define  absorption 
and  scattering  functions  typical  of  natural  waters:  "Lake  Limne"  and  "the  Pelagos  Sea"  which 
are,  respectively,  typical  of  lakes  and  open  ocean  waters.  The  other  two  examples  of  PHASEF 
are  for  a  spherical  scattering  function:  one  is  depth  independent  and  one  is  for  depth  dependent 
absorption  and  scattering.  The  user  wishing  to  make  runs  with  his  own  absorption  and  scattering 
functions  must  write  a  corresponding  version  of  PHASEF,  mimicking  the  listed  examples. 

Likewise,  a  user  wishing  to  specify  an  input  radiance  distribution  other  than  the  ones 
obtainable  from  the  formulas  in  Appendix  B  must  write  a  corresponding  version  of  subroutine 
QASKY.  This  would  be  the  case  if,  for  example,  the  user  had  measured  the  sky  radiance  distri¬ 
bution  with  a  few  cumulus  clouds  present  in  an  otherwise  clear  sky,  and  wished  to  include  the 
cloud  effects  in  the  computed  radiances. 


C.  File  Management 

Three  permanent  files  are  either  read  or  written  by  Program  4;  an  additional  three  tempo¬ 
rary  files  are  used  for  scratch  storage. 


internal  name 

external  name 

description 

NUSRT 

TAPE30 

The  file  of  spectral  f  and  t  arrays  for  the  air-water 
surface,  from  Program  3. 

NLPHAS 

TAPE39 

The  file  containing  the  quad-averaged  phase  func¬ 
tion.  It  is  written  if  ICPHAS  0  and  read  if 
ICPHAS  =  0. 

NUOUT 

TAPE40 

The  file  containing  the  radiance  amplitudes  (and 
other  information)  generated  by  Program  4. 

NUSCRl 

NUSCR2 

NUSrR3 

TAPE45 

TAPE46 

TAPF47 

Temporary  scratch  files  used  in  integrating  the 
Riccati  equations.  NUSCRl  holds  R(y,x;f); 

NUSCR2  holds  T(x,y;f);  NUSCR3  holds  Ri(y,b;f) 
and  R2(y,b;f). 
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D.  Code  Listing 


c 

c 

c 

c 

c 

c 

c 

r 

C 


c 


c 


PROGRAM  MAIN( INPUT , OUTPUT . TAPE6= INPUT . TAPE6=0UTPUT , TAPE UO . T A PE 39 . 
1  TAPEAO , TAPE46 , TAPE46 . T APE47 ) 

ON  NhM4/MAIN4 


+  This  is  program  4  of  the  natural  hvdrosol  model  + 


PARAMETER (MXMU= 10 .  MXPHI=24.  MXV-30.  MXSIGV=3) 

parameter (MXL=MXPH I / 2 .  MXALGP=MXMU* (MXL* 1 ) ,  MXAMP= 2 ‘MXMU • ( MXL+ 1 ) ) 
PARAMETER  (MXRRTH  =  MXMU»  (MXL-^  1  )  .  MXCR Th-^MXMU *  (  (MXL-*  2)  /  2)  ) 
parameter  CMXWERK  =  MXMU«MXMU*  (  1  3»(MXL*l)*(l  ♦  (  MXL-»  2  )  /  2  )  )  ) 

COMMON/CAMP/  AAM(MXAMP) .AAPIMXAMPj . A VM ( MX AMP . MX V ) , A V P ( MXAMP , MXV ) 
COMMON/ CS I  GY/  VSIG(MXSIGV)  .AlBESS(MXSIGV)  .TOTALS! MX SIGY) 

COMMON /CR ADO/  JMUO(MXSRC) .KPhIO(MXSRC ) ,RADO(MXSRC) 

COMMON /CRTR/  R YX ( MXMU . MXMU . MX  V )  ,  T X Y ( MXMU . MXMU , MX Y )  . 

1  R 1 YB ( MXMU , MXMU . MXY ; . R2 Y6( MXMU . MXMU . MXY ) 

COMMON /CGR  10/  FMu  !  MXMU  )  .  PhI  (  MXPi-il  )  .  v  (  MXV  )  .  bNDMu(  MXMu  )  , 

1  BNDPHI (MX PH  I  )  , OMEGA ( MXMU )  . UELTMuI MXMu )  . ZGEO( MXV ) 

COMMON/CRTSIG/  RmOHAT (MXMU . MXMu . MX S I uV )  , TAUHAT ( MX MU . MXMU , MX S I  GY )  , 
1  AlGPP( MXMU .MxAlGP.MXSIGY) .AuGPMi MXMu , MXAlGP . MXS IGV ) 
common /C60TBC/  RhATZB( MXMu .MXMU) 

COMMON /CRTHA  T/  1(MxRRTh.Mx(R1iii  :mAT/(MxRRTH.MXCRTH)  . 

1  RHA11(MXRR''H.MX'M’u  wnAr2(MxRRTH.MXCRTH) 

COMMON/ CM I SC /  IM i ; V  ( 20  )  . FMI SC ( EU  • 

COMMON/CwORK/  wERk.MXwERK) 

DATA  NuSRT/30/.  Nj,jUT/4U/.  rm  R  1  .  f<u  R  Y  .  NUSCR  3  /  4b  .  46 . 4  7  / 

I N I  1  I  A;  [ ZAT ION 


READ  The  [f^P'jT  uA’A 

CAlL  INIShl 
C 

NSIGY  -  IMI SC ( b  ; 
IMISC(18)  =  NUSCRI 
IMISC(19j  =  NUSCRZ 
IMISC(20)  =  NuSCR, 

C 

NMU  =  IMI  Si:  (  1  ) 

NL  =  IMISCO) 

NY  =  I M I  SC (  4 ) 
iOBUGZ  =  IMI SCI  j  ; 
NRMA  t  =  1  M  I  SC  (  i ' 


r^CHA  -  i  M 

I  S 

c  ■  .  ■ 

r.RAMP  =  2* 

A  hA 

c 

c 

initial  load 

0  1 

HE 

SPEC 

T  A  A 

L  1  R 

c 

T  hi  A  T  1  (  A 

,  'K 

;  .  0  • 

J 

THA  T  1 

c 

T  2  (  A 

.  /  )  I  • 

[J 

'nA'^2 

r 

PMA  T  1  (  X 

,  A 

;  I ' '  ’ 

PtiA  r  1 

c 

(  A 

.  A 

)  i  ■  ■ ' 

m'ma  r 2 

c 

00  lij.j  j-^1 

.  fi 

lOU 

P  E:  AO  ( r^u  Sft  T 

) 

f  T  r-i  A  ' 

1  i 

I  .  J )  . 

I  ^  i 

.  NWHA  ’ 

00  101  j^l 

.  NCHA  T 

10  1 

P  t  A  0  [  N  li  S  A  I 

) 

(  T  riA  ' 

x;  t 

I .  J ) , 

:  ^  1 

.  N  k  M  A  " 

00  \rrz  j^i 

,  N  (>t  A 

lU*' 

►yf:  AO  1  jbR  T 

J 

(  PfiA 

1 1 

I .  J ) . 

i  -  1 

.  A  T 

[iO  lot  J  =  1 

.  N 

Cha 

O  '  J 

A  C  A  0  (  N  i  j  'c  P  T 

; 

(  A  h  O.  ' 

*■ . 

I .  J ) . 

I-  1 

.  k  M  A  I 
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c 

I F ( 1 DBUG2 . GT . 0 )  THEN 

CALL  P2ARAV( TMATI . 2*NMU, NMU.M>RRTH. 2 .  • that  1 ( A . X)  Ab  LOADED ’  ) 

CALL  P2ARAV (THAT2 . 2*NMU . NMD .MXRRTH. 2 . ' THAT2( A . X)  AS  LOADED') 

CALL  P2ARAY (RHAT 1 , 2*NMU .NMU .MXRRTH. 2 . ■ RHATl (X , A )  AS  LOADED') 

CALL  P2ARAY (RHAT2 . 2*NMU , NMU .MXRRTH. 2. 'RHAT2(X . A )  AS  LOADED') 

ENOIF 

**»«»**«*»  BEGIN  COMPUTATIONS 

COMPUTE  THE  DIRECT  BEAM  AMPLITUDES  AO(V,-)  AT  ALL  LEVELS  Y  =  A.  X . Z 

FROM  THE  QUAD-AVERAGED  SKY  RADIANCES  (WHICH  ARE  STORED  IN  /CWORK/) 

CALL  AMPAO 

/CWORK/  IS  NOW  ENTIRELY  FREE 

SAVE  AQ(Y.-)  (STORED  IN  AAM )  AT  ALL  V  LEVELS 
WRITE(NUOUT)  (AAM( I ) . 1=1 .NRAMP) 

DO  150  J= 1 .NY 

150  WRIT£(NU0UT)  (AVM( I . J) . I=1,NRAMP) 

I F ( IDBUG2 . NE . 0 )  THEN 
WRITE{6.  1038) 

CALL  PNTAMP( Y , AAM . AVM , MXAMP) 

ENOIF 

COMPUTE  THE  INTERIOR  TRANSFER  FUNCTIONS  BY  INTEGRATION  OF  THE 
RICATTI  EQUATIONS 

EACH  L  MODE  IS  INTEGRATED  SEPARATELY 
DO  200  L=0.NL 

SET  DEBUGGING  OUTPUT  FOR  SELECTED  l  VALUES 
I F ( I DBUG2 . GT . 0)  TmEN 

I^^L.Lc..l  .OR.  L.GE.Nl-1)  I  hen 

IDBUG  =  IO0UO2 

ELSE 

IDBUG  =  0 
ENDIF 

ELSE 

IDBUG  =  I06UG2 
ENDIF 

IMISCIB)  =  IDBUG 

SOLUTION  STEP  1  (SEE  PAGE  133  AND  FIGURE  7  ON  PAGE  140) 

COMPUTE  RhOHAT  and  TAUHAT  at  EAlh  y  iEvEL  where  sigma  AND  ALPHA 
ARE  GIVEN 

CALL  RHOTAU(L) 

I F ( I OBUG . GT . 0 )  THEN 
WRITE(6,202)  L 

CALv  P3ARAY(RHOr'AT,NMU. NMu . N S I u * . MaMU . MXMU . 2 , ' RHOHAT ( L ) ' ) 

CALL  P3ARAV( TAUhAT , NMU . NMU . NS IGv , MaMU . MXMU . 2 , ' TAUHAT ( L ) ' ) 

ENOIF 

ttaa  solution  step  2 

COMPUTE  RHATUZ.B)  FOR  THE  DESIRED  BuITOM  BOUNDARY  CONDITION 
call  BOTMBC(L) 

IF(IDBU&.GT.0)  -..all  P2ARAY(RHAT2B.  NMli  .  NMU  .MXMU  ,  2  .  '  RHA  T  1  (  Z  ,  B  ,  L  )  '  ) 

C 

C++TT  SOLUTION  STEPS  3  AND  4 

C  INTEGRATE  ThE  RICATTI  EQUATIONS  TO  GET  R(V,X),  TCX.V).  AND  RP(Y.B) 


C  write  R(V,X),  *'X.Y)  AND  RP(V.B)  FUR  THIS  L  VALUE  TO  SCRATCH  FIlES 

C 

DO  220  I Y= 1 , Nv 

wRITE(NuSCRl  )  (  (RYX(I  ,j,Iv)  ,1-1  , nMu  J  . j= I . NMU ) 

wRlTE(NUSCR2)  ((TXY(I,J.lYi.I=l, HMJ ) . j= I , NMu ) 

WRITE) NUSCR3 )  ((R1yB(I.J,IV1,I-i, nMu 1 , J= 1 . NMU ) 

22U  WR I r E ( NUSCR3 )  ( ( R 2 Y0 ( I , j . I y ) . I = 1 . NMU ) , J = 1 , NMU ) 

I F ( I dbug . eq  .  2 )  Then 

call  P3ARAV(RYX. NMU , NMU . NV . MXMU , MXMU , 2 . ' R { V , X , L ) ' j 
call  P3ARAV(TXV,NMU,NMu.Ny.MXMU, MXMU .2. 'TIX.V.L) ' ) 

CALL  P3ARAY(R1Y8, NMU , NMU . NY . MXMU .MXMU ,2. 'R1(Y.B,L) ' ) 

CAl.-  P3  AR  a  Y  (  R  2  VB  ,  NMU  ,  NMu  .  NY  .  MxMu  .  MXMU  2  'R2(y  0  L)') 

ENDIF 
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200  continue 

*•  +  +  +  SOLUTION  STEPS  5  AND  6 

COMPUTE  THE  AMPLITUDES  A(X,-i  AND  A  (  X  ,  ) 

CALL  AMPX 

+  SOLUTION  STEPS  7  AND  8 

COMPUTE  THE  INTERIOR  AMPLITUDES  A(V.-)  AND  A ( V , + ) .  X  . LT .  V  . LE .  Z 
CALL  AMPINT 

FINAL  LOAD  OF  SPECTRAL  STORAGE  ARRAVS 
THATI(X.A)  INTO  THATI 
ThAT2(X.A)  INTO  THAT2 
RHATI(A.X)  INTO  RHATl 
RMAT2(A.X)  INTO  RMAT2 

DO  400  J=1,NCHAT 

400  READ(NUSRT)  { THA T I ( I , J ) , I = 1 . NRHA T ) 

DO  401  J=1,NCHAT 

401  READ(NUSRT)  ( THAT2 { I , J ) . I = 1 . NRMAT ) 

DO  402  J^l.NCHAT 

402  READ(NUSRT)  ( RHA T 1( I , J ) , I = 1 . NRhA T ) 

DO  403  J=1.NCHAT 

403  READ(NUSRT)  (  RH  A  T  2  (  I  .  J  )  .  I -•  1  ,  NRHA  T  ) 

I F ( IDBUG2 . GT . 0  )  TmEN 

CALL  P2ARAV ( Thai  1  .  3 ‘NMU , NMU .MXRRTh. 2 .  • THAT  1 ( X . A )  AS  LOADED') 
call  P2ARAV ( THAT2 . 2»NMU , NMU .MXRRTH . 2 .  that 2(X , A )  AS  LOADED’) 

CALL  P2ARAV (RHAT 1 . 2*NMU , NMU .MXRRTh , 2 . ' RhAT 1 ( A , X)  AS  LOADED') 
call  P2ARAV(RHAT2 . 2»NMU . NMU .MXRRTh, 2 .  RHAT2(A,X)  AS  LOADED') 

ENOIF 

♦+++  SOLUTION  STEP  9 

COMPUTE  The  amplitude  A  )  A  . ) 

call  AMPAP 

WERK(l)  NOW  CONImINS  A0(A.»).  THE  REFLECTED  DIRECT  BEAM 
END  OF  COMPUTATIONS 
SAVE  The  computed  AMPIITuOES 

WRITE! NuOuT )  ( WERK ( I ) . I = 1 . NR AMP ) 

WRITE(NUOUT)  ( A4M( 1) . 1=1 .NRAMP) 

WRITE(NUOUT)  { AAP ( I ) , I = 1 , NRAMP) 

DO  450  J= 1 . NV 

450  WRITE(NuOUT)  ( AVM( I , j ) . I = 1 . NRAMP ) 

DU  45  1  J  =  1  . NY 

451  wRITE(NuOUT)  C a VP( I , j) , I = 1 . NRAMP) 

ENDFIlE  NUOUT 

I F ( I DBUG2  .  NE  .  a  ;  ThEN 
WR ITEl 6 ,  10  39  ) 

call  PNTAMPIV,.'.  FRK.  1,E201.MxAMP) 

WR I TE ( 6 . 1040 ) 

CALL  PNT  AMP  (  V  ,  A  AM  .  A  VM  ,  MXAMf' ) 

WRITE(6,  1042) 

call  PNTAMP(y,AAP,AYp, MX AMP ) 

END  I  F 
C 

WRITE  (6. 500)  N’.Ou’T 

202  FOPMaT(ih1,'  BEGINNING  THE  L  ='.13.'  LOOP  •^  +  •^  +  +■) 

SOU  FORMATIIHO,'  normal  exit  from  PROGRAM  4,  TAPE', 12,'  WRITTEN.') 

1038  F0RMAT(1H1,’  The  DOWNWARD  DIRECT  BEAM  RADIANCE  AMPLITUDES  ARE’// 

1  llx,  MU’.TX,  AO ( A  ,  -  )  ’  . 8X .  ’ AO (  V  .  -  )  ’  ) 

1039  FORMAT!  IHl,’  THE  UPWARD  DIRECT  BEAM  RADIANCE  AMPLITUDES  ARE’// 

I  IIX ,  MU ’  ,  7X ,  AO! A , »  )  '  ) 

1040  FORMAT!  IHl,  THE  DOWNWARD  TOTAl  RADIANCE  AMPLITUDES  ARE’// 

I  11X,’MU'.7X,  A ! A . - )  . 9X . ’ A ( V .  1  ) 

1U42  FORMAT!  IHI,’  TmE  UPWARD  TOTAl  RATilAr.i.F  AMPLITUDES  ARE' 

I  / /  I  IX  ,  Mu  ’  ,  7X  .  A  I  A  .  »  )  ’  , 9X .  ’ A !  V .  •  )  j 
END 
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subroutine  INISHL 
ON  NHM4/INISHL4 

This  routine  initializes  program  4  of  the  nhm. 

PARAMETER(MXMU=IO,  MXPHI=24.  MXV=30.  MXSIGV=3) 

PARAMETER (MXGEOP  =  MXMU» ( MXPHI / 2+1 )  ) 

C 

COMMON/CMI SC/  IMISC(20) .FMISC(20) 

COMMON /CRTS I G/  RHOHA T ( MXMU , MXMU . MXS I GV ) , T AUHAT C MXMU . MXMU . MXS I GV ) , 

1  GEOPP(MXMU,MXGEOP,MXSIGY) . GEOPM ( MXMU , MXGEOP . MXS I GV ) 

COMMON/CGRID/  FMU(MXMU) .PHI (MXPHI ) , YOUT{MXV) .BNDMU(MXMU) . 

1  BNDPHI (MXPHI ) ,OMEGA(MXMU) . DELTMu ( MXMU ) ,ZGEO(MXV) 

COMMON/ CS I  GY/  YSIG(MXSIGY ) , ALBE SS ( MXS I GV )  . TOTALS (MXSIGV ) 

COMMON /CWORK/  RADSKY (MXMU .MXPHI ) , PhASE( 270  l.MXSIGV).PSITAB(2701) 

C 

DIMENSION  ITITLE(IO) 

C 

DATA  NUSRT , NUPHAS , NUOUT/30 .39,40/ 

C  KINV . THE  NUMBER  OF  TERMS  IN  THE  SUM  (7.4) 

C  TOL . the  tolerance  FOR  THE  RICCATI  EQUATION  SOLVER  (IMSL  ROUTINE  DvERK ) 

DATA  KINV/3/.  TOL/l.OE-B/ 

C 

C  READ  INPUT  RECORDS 

C 

C  RECORD  1 : 

C  ITITLE....A  RUN  TITlE,  UP  TO  80  CHARACTERS 

c 

C  RECORD  2: 

C  IDBUG . 0  FOR  NO  intermediate  OUTPUT  (PRODUCTION  RUNS) 

C  1  FOR  MINIMAL  OUTPUT  FOR  ChCCKING  (RECOMMENDED) 

C  2  FOR  full  DEBUGGING  OUTPUT 

C  WAVENM.  .  .  . THE  WAVELENGTH  IN  NANOMETERS.  ONE  OF  THE  13  VALUES  400., 425  . 

C  675., 700.  (SEE  PHASEF  FOR  TmE  PElAGOS  SEA) 

C  ABSORB  ....  IF .G£ . 0 .  .  THEN  THE  ABS0R6T10N  COEF  A  IS  RESET  TO  THIS  VALUE 

C  (USED  FOR  LAKE  LIMNE  RUNS  TO  VARY  A  WITH  WAVELENGTH) 

C 

C  RECORD  3: 

C  ICPHAS....0  IF  THE  OUAO-AVERAGED  PHASE  FUNCTIONS  ARE  TO  BE  READ 

C  FROM  UNIT  NUPHAS 

C  .NE.O  IF  The  QUAD- AVER AGED  PHASE  FUNCTIONS  ARE  TO  BE  COMPUTED 

c  (BY  Subroutine  qaphas)  and  stored  on  unit  nuphas 

c  IF  ICPHAS.lt. G,  THE  run  STOPS  AFTER  NUPHAS  IS  WRITTEN 

C  IF  ICPHAS.GT.O.  THE  RUN  CONTINUES,  AND  COMPUTES 

c  amplitudes 

C  NUQB , NVQB . THE  BASE  NUMBERS  OF  SUBCELLS  (IN  THE  MU  AND  PHI  DIRECTIONS) 

C  USED  TO  DISCRETIZE  THE  PHASE  FUNCTION  VIA  EQ .  11.3 

C  (USED  ONLY  IF  ICPHAS.NE.O) 

C  INCBAS. . . . The  factor  FOR  INCREASING  THE  BASE  NUMBER  OF  SUBCELLS 

C  FOR  QUAD  PAIRS  WHICH  INCLUDE  FORWARD  SCATTERING 

C 

C  RECORD  4; 

C  IBOTM . 0  FOR  A  MATTE  BOTTOM  AT  Y  -  Z.  OF  REFLECTANCE  R-  =  RFLBOT 

C  1  FOR  AN  infinitely  DEEP  BOTTOM.  WITH  HOMOGENEOUS  WATER 

C  BELOW  depth  V  -  Z 

C  RFLBOT ....  THE  BOTTOM  REFLECTANCE.  (USED  ONLY  IF  IBOTM  =  0) 

C  U.O  .LE.  RFLBOT  . LE .  1.0 

C 

C  RECORD  5; 

C  lYOP . 0  IF  vOUT  AS  READ  CONTAINS  uEUMETRIC  DEPTHS  IN  METERS 

C  (USE  FOR  UNIFORM  WATER  ONLY,  AS  OF  30  JUNE  86) 

C  1  VOUT  AS  READ  CONTAINS  OPTICAL  DEPTHS 

c  NY . The  Number  of  y  levels  where  output  is  desired 

C  VOUT(I) . VOUT ( NY ) . . . the  depths  WHERE  OUTPUT  IS  DESIRED 

C  RECORD  6: 

C  RSKY . THE  RATIO  OF  SKY  TO  TOTAL  INPUT  SCALAR  IRRADIANCE 

c  RSKV  =  0.  FOR  A  Black  sky  (Sun  only),  RSKY  =  l.O  FOR  A 

C  BACKGROUND  SKY  ONlY  (NO  SUN) 

C  CARO . The  CARDIOIDAL  PARAMETER  FOR  THE  SKY  RADIANi.E 

C  DISTRIBUTION.  CARD  =  0.  FOR  A  UNIFORM  SKY.  CARD  =  2.  FOR  A 

C  CARDIOIDAL  SKY 
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C  SHTOTL . . . . THE  TOTAL  ( SKV  ♦  SUN)  SCALAR  IRRAOIANCE  ON  THE  WATER 

c  Surface,  watts  per  square  meter 

C  thetas,  phis... the  SKV  (SOURCE)  LOCATION  OF  THE  SUN,  IN  DEGREES. 

C  THETAS  IS  0.  AT  THE  ZENITH.  90.  AT  THE  HORIZON.  PHI  IS 

C  MEASURED  COUNTERCLOCKWISE  FROM  PHI  =  0.  IN  THE 

C  DOWNWIND  DIRECTION 

C 

READ{5,1004)  ITITLE 

READ(5,*)  IDBUG.WAVENM, ABSORB 

READ(5 , « )  ICPHAS . NUQB , NVQB , INCBAS 

READ(5.»)  IBOTM.RFLBOT 

REA0(5.»)  IVOP.NV,  (VOUTC I Y  )  , 1 V  =  1  . NV ) 

READ(5,*)  RSKV.CARD, SHTOTL . ThETAS .PHIS 
C 

C  READ  HEADER  RECORDS  FROM  TriE  SPECTRAL  DATA  FILE,  NUSRT 

c 

REWIND  NUSRT 

READ (NUSRT)  NUN  IT ,  I  MI  SC . FMI SC . FMU . PHI  . BNDMU , 8NDPHI  , OMEGA , DELTMU 
C 

NMU  =  IMI SC ( 1 ) 

NPHI  ^  IMISC(2) 

NL  =  IMISCO) 

TWOPI  =  2.0*FMISC(1) 

DEGRAD  =  FMISC(2) 

RADEG  =  FMISCO) 

WNDSPD  =  FMISCdS) 

KCOL  =  NMU»(NL  +  1) 

C 

WRITE(6. 1000) 

WRITE(6. 1006)  ITITLE 

WRITE(6, 1010)  NMU , NPmI , NY , NL , WNDSPD . WAVENM , K I NV , TOL 
IFdCPHAS.NE  .0)  WRI  TE(6 , 1014)  NUQB  ,  N  vQB  .  I  NCBA  S 
IF(iaOTM.EQ.O)  WRITe(6, 1030)  RFi.BOT 
IFdBOTM.EQ.  1)  WRIT£(6.  1031) 

C 

IMISC(4)  =  NV 
IMISC(8)  =  KINV 
I"ISC(9)  =  IDBUG 
IMISC( 12)  =  IBOTM 
FMISC(7)  =  TOi. 

FMI SC ( 13 )  =  WAVENM 

FMISC(  14)  =  RF^Ei 
C 

C  COMPOTE  The  dNf‘U';  QUAD- AVERAGED  RADIANCES  FOR  THE  SKY 

C 

call  QASKV(RSkv,caR0,ShTCTL. thetas. PH IS) 

C  RADSKY  IS  IN  /CWORK/  AND  MUST  BE  SAVED  UNTIL  AMPAO  IS  CALLED  IN  MAIN 

C 

I F ( I CPHA5 , NE . 0 )  Then 
C 

C  COMPUTE  AND  SAVE  THE  QUAD  -  A VER AGE D  PHASE  FUNCTIONS 

C 

C  INITIALIZE  The  P^rNT  geometric  scattering  FUNCTION 

c 

note,  MAKE  SURE  "hE  DESIRED  VERSION  OF  PhASEF  hAS  BEEN  LOADED 
INTO  The  EKECUTABuE  element  (ABSOLUTE  RUN  FIlE) 

C 

<>  H  -  PHA  S  E  F  (  0  .  ,  j  ,1 
NilGV  ^  IM!SCI=^; 

C 

L  GENERATE  A  TABLE  uF  PHASE  EuNulluN  values  FUR  LOOKUP  IN  UAPHAS 

C  /CwORK/  IS  USED  hOlD  ThE  TABLE  OF  PHASE  VALUES 

C 

DO  100  I  Vi  1  .  NS  1  (■.  - 
V  =  /  S  I  G  (  I  V  ) 

C 

C  0  .lE.  PSI  .lE,  10  DEGREES.  BY  0.01  DEGREE  STEPS 

DPSI  =  DE&RAD*rj.C: 

DO  102  1=1. 1001 

PSITAB(I)  =  float (  I  -  1 ) ‘DPSI »RADEG 
COSPSI  =  C0S(  FL.GAT  !  I  -  1  )  «OPSI  ) 

102  PHASElI.lV)  =  PHASEF (V . COSPSI ) 

C 
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C  10  .LT.  PSI  .LE.  180  DEGREES.  BY  0.1  DEGREE  STEPS 

OPSI  =  DEGRADED . 1 
PSIO  =  DEGRAD*10.0 
DO  100  1=1002,2701 
PSIO  =  PSIO  +  DPSI 
PSITAB(I)  =  PSn»RADEG 
COSPSI  =  COS'P' !Q) 

100  PHASE(I.IV)  =  PHASEF(V .COSPSI ) 

C 

IFdDBUG.GE.  1)  THEN 
WRITE(6, 1050) 

DO  110  1=1.20 

12  =  I  +  990 

13  =  I  ♦  2681 

110  WRITE (6. 1052)  I . PSI TAB ( I ) . PHASE! I.1).12.PSITAB(I2). PHASE! 12 . 1) . 

1  I3,PSITAB(I3)  .PHASE(I3.  1) 

CHECK  integral  OF  PHASE  FUNCTION  BY  SUM  OF  TABULATED  VALUES 
SEE  PAGE  11,  EQ  2.7. 

DPSI  =  DEGRADED. 01 

SUM  =  PHASE(2, 1)»SIN(PSITAB{2)»0EGRAD)»0.5»DPSI 
DO  120  1=3.1000 
C  PSI  =  0.01  TO  0.1 

IF(I.EQ.ll)  SUM01  =  SUM  PHASE  (  I  ,  1 )  *  S I N  (  PS  I  T  AB  ( I  )  *DEGRAD )  ♦  0 . 5  ♦DPS  I 

C  PSI  =  0.01  TO  1.0 

IF(I.EQ.lOl)  SUM1  =  SUM  PHASE  (  I  .  1  )  ♦  S 1  N  (  PS  I  T  AB  (  I  )  ♦  DEGR  AD  )  »  0 . 5 ‘DPS  1 

120  SUM  =  SUM  I-  PHASE! I , 1)»SIN(PSITAB( 1 )*DEGRAD)»DPSI 

SUM  =  SUM  +  PHASE ! 1001 . 1 ) ‘SIN! PSITAB! 1001 ) *DEGRAD) *0 . 5»DPS1 
C  PSI  =  0.01  TO  10.0 

SUMIO  =  SUM 
DPSI  =  DEGRAO’0 .  1 

Sum  =  SUM  ♦  PHASE ! 100  I .  1 ) ♦SIN!PSITAB!  1001 )»DEGRAD) *0 . 5»0PSI 
DO  122  1=1002,2700 
C  PSI  =  0.01  TO  20. 

IF ! I  . EQ .  1  101 )  SUM20  =  SUM  ♦  PHA SE ! 1  10 1 . 1 j »0 . 5 ♦ DPS  I 
C  PSI  =  0.01  TO  90.0 

IF(I  .EQ.  1801)  SUM90  =  SUM  ♦  PHA SE ! 180 1 . 1 ) • 0 . 5 ♦ OPS  I 
122  SUM  =  SUM  +  Phase (  I .  1  ) ‘SIN! PSITAB!  I ) »OEGRAD ) ♦DPSI 
SUMOl  =  TwOPI'SLMOl 
SUMl  =  rwOPI’SUMl 
SUMIO  =  TW0PI*SUM10 
SUM20  =  TW0PI*SUM20 
SUM90  =  TWOPI*SUM90 
SUM  =  TWOPI*SUM 
SuMOaO  =  SUM  -  SUM90 

WRI TE! 6 ,  1054 )  SUMO  1  , SUMl  , SUMIO . SOM20 , SUM90 , SUM980 , SUM 
ENDI  F 
C 

C  COMPUTE  THE  UU AU - A V ER AGED  GEOMETRIC  PHASE  FUNCTION  AS  IN  SECTION  11 

C 

call  qaphas ( nuOB , nvob . incbas ) 

c 

C  STORE  THE  COMPUTED  PHASE  FUNCTIONS  FOR  LATER  USE 

C 

REWIND  NUPHAS 

WRITE! NUPHAS )  SI  GY. YSIG.ALBESS. totals 

WRITE! NUPHAS )  (  !  ( GEOPP! I  . J , K  )  .  I  =  1 . NMU )  , J= 1  . KCOL )  , K= 1 , NSI GY ) 

wR I TE! NUPHAS )  I i IGEOPM! I , J , K) . I = 1 . NMU ).J=l,KCOL) ,K=1,NSIGY) 

ENDF I lE  NUPHAS 
WRITE!6,  1060)  NUPHAS 
I F ( I CPHAS . LT . 0 )  STOP 
C 

ELSE 

C 

C  READ  existing  Quad-averaged  phase  functions  from  nuphas 

c 

REWIND  NUPHAS 

READ! NUPHAS )  NSIGV.YSIG.AlBESS, TOTALS 

READ! NUPHAS)  ((!GEOPP!I,J.K),I  =  l  . NMu )  .J=l,KCOL)  .K=l,NSIGy) 
REA0!NUPHAS )  ( ( ( GEOPM! I , J , K) . I = I . NMU) , J= 1 . KCOL ),K=1,NSIGV) 

IMISC(5)  =  NSIGV 
C 

C  RESET  THE  ALBEDO  OF  SINGLE  SCATTERING  1  THE  SCATTERING  TO  ATTENUATION 

C  RATIO)  IF  DESIRED 

IF  f  absorb . GE . 0 .  )  THEN 

AlBESS(I)  =  totals !  1  )/( TOTALS!  1  )  +  ABSORB) 

ENDI  F 
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c 

ABSORB  =  TOTALSC 1 ) *( 1 .0/ALBESS( 1)  -  1,0) 

WRITEC6,1070)  ABSORB . totals ( 1) .AlBESS(  1) 

c 

IF( IDBUG.GT.O)  THEN 

CALL  P3ARAV(GE0PP .NMU , NVU .NSIGV .MXMU .MXGEOP , 2 , 

1 ' QUAD-AVERAGED  P+ ( V . R , 1 / U , V)  AS  LOADED ' ) 
call  P3ARAV(GE0PM, NMU . NMO .NSIGV ,MXMU .MXGEOP . 2 , 

1 ■ QUAD-AVERAGED  P - ( Y , R , 1 / U . V )  AS  LOADED') 

ENDIF 

C 

ENDIF 

C 

I F ( I VOP . EQ . 1 )  THEN 

VOUT  AS  READ  CONT.TINS  THE  OPTICAL  DEPTHS 

COMPUTE  The  geometric  depths  CORRESPONDING  TO  THE  OPTICAL  DEPTHS 

where  output  is  requested 

CALL  V2ZGE0 

else 

VOUT  AS  READ  CONTAINS  THE  GEOMETRIC  DEPTHS  IN  METERS.  COMPUTE 
The  CORRESPONDIN.,  OPTICAL  DEPTHS  (UNIFORM  WATER  ONLY) 

ALFA  =  ABSORB  TOTALS(l) 

DO  200  IY=1,NY 
ZGEO( I Y )  =  YOUT ( I Y ) 

200  YOUT(IY)  =  ALFA»ZGE0( I Y ) 

ENDIF 

WRI  TE  (6. 1020)  .'CUT  '  1  )  ,  YOUT  (  Nv  ) 

WRITE(6.1025)  (IV.YOuTIIy)  ,2u£D( 1 V  )  . 1 Y  =  1  ,NY ) 

WRITE  header  RE<_OROS  ONTO  THE  AMPLITUDE  DATA  FILE 

REWINO  NUOUT 

WR  I  TE  C  Nl.OUT  1  IMI  S(.  ,  FMI  SC  .  FMu  ,  PH ;  .  voi/T  ,  BNDMO  ,  BNDPHl  ,  OMEGA  ,  DElTMU  . 

1  YSIG,  AlBESS,  ;  iTAlS.ZGEO 

WRI  TE  (  NUOUT  )  (  (  '  G£OPP(  I  .  J  ,  K  )  .  I  =  1  .  NMU  )  .  J=  1  .  KCOL  )  ,  F.=  I  ,  NSIGY  ) 
write;  NUOUT  )  (  ',  (  GEOPMl  I  .  J  .  K  )  .  I  =  1  .  NMU  >  .  J  =  I  .  KCOL  )  ,  K=  1  .  NSI  GY  ) 

RETURN 

NOW  DONE  with  _wORK/ 
format  statements 

1000  FOPMaT(1h1,’  PROGRAM  A  OF  THE  NATURAL  HYDROSOL  MODEL’// 

1'  solution  of  THE  RADIATIVE  TRANSFER  EQUATION  IN  A  PL ANE - PAR A L LE L 

2  MEDIUM ’ ) 

1004  format ( 10A8 ) 

1006  format;// ■  RUN  TIT^E;  ’.lOAS) 

1010  format;//.'  Tmc  grid  parameters  are  //TS.NMU  =',I3// 

1T7,'NPHI  =  ’  ,  I.J.,  /'^9,  'NY  ='.I3//'  other  PARAMETERS  ARE'// 

2T9,'NL  =’.I3,'  -  hIuhEST  WAVENUMBER  L  IN  FOURIER  ANALYSIS  OF  PHI'/ 

3/T5.'WNDSPD  =','=5.2,'  M/SEC'// 

7T5, LAMBDA  ='.'b.l,  NANOMETERS// 

4T7,'KINV  -  ■  ,  I  .  =  highest  POWER  OF  THE  SERIES  EXPANSION  USED  FOR 

5MATRIX  I  NVER  r  :  .N  '  /  /  ■''3  ,  ■  TOl  =',lPEe.l. 
b  =  EPhOR  TOl  -  Un.E  FOR  RICI.ATI  EO  .  INTEGRATIONS’) 

1014  format;//’  The  Phase  '^uNCTIO'.  is  Quad  -  AVERAGED  USING  NUQB  ='.13, 
1’,  NVQB  =’,I3.  and  INCBAS  =  .13) 

1020  FORMAT ;//• THE  Si AB  THICKNESS  IS  X  =  ,F6.2,’  .lE.  Y  ,LE.’. 

1  F6.2,  =  Z  optical  DEPTHS’) 

1025  format;//’  Cl  CuT  IS  AT  ThE  FOlLOwING  DEPTHS:’// 

1  ■  V  INDEX  OP'  OEP'H  GEl  depth  (m)  / / (  I 5 , F  1  2 . 3 , F  1 6 . 3 )  ) 

1030  format;//’  The  bottom  B.,'.)NDARv  is  a  MATTE  SURFACE  WITH  REFLECTANCE 

1  R-  =  , F6 . 2 ) 

1031  format;//-  ThE  BOTTOM  BOUNDARY  Is  INFINITELY  DEEP’) 

1050  FORMAT) IHl,  SELECTED  VALuEs  OE  ThE  TABULATED  PHASE  FUNCTION'// 
14X.’ index  phi  PHASE'. 7x.  INUbx  PHI  PHASE', 7X, 

2  I NDEX  PH  I  PHASE  / ) 

1052  Format;  3X,3;  I5,;jPF9.2.  1PE1J.5.3X)  ) 

1054  foRMATIIhO,’  integrals  of  2»P1 ‘Phase ( PsI  )  • S I N( PSI  )  »DPS  I  :  /  / 

1’  IlO.Ol-O.n  =  .1PE13.6//’  1(0.01-1.0)  =  .E13.6// 

2'  no.  0  1-10.;  =’,E13.6//'  1(0.01-20.)  =  ,E13.6// 

3'  I(O.Cl-90,)  ^’,E13.6//'  1(90. -180.)  =’,E13.6// 

4'  i;n.01-lB0)  -',513,6) 

lUbO  format; ImO,  TAPE', 12,'  OF  QUAD- AVER AGEU  PHASE  FUNCTIONS  WRITTEN') 
1070  format;//’  for  This  run,  a  ='.F6  3.3X.’S  =’,F6.3,3X, 

1  A  .  B  E  DU  =  ’  , F  S  i  , 

END 
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subroutine  ADI PAK(X , V . IROW . NMU , L) 

THIS  ROUTINE  COMPUTES  I  +  X  =  V.  WHERE  I  IS  THE  IDENTITY  MATRIX  AND 
X  AND  Y  ARE  BLOCK  MATRICES  STORED  ON  THE  PACKED  FORMAT  OF  12.4. 

DIMENSION  X(IROW,  1)  , Y(IROW. 1) 

MLR  =  NMU*(L'<-1) 

MLC  =  NMU«( (L+2)/2) 

DO  99  1=1, MLR 
DO  99  J=1.MLC 
99  Y(I . J)  =  X(I . J) 

ADO  1.0  TO  the  diagonal  ELEMENTS 

LPl  =  L+1 
DO  100  IXB=1.LP1 
JXB  =  (IXB-H)/2 
II  =  (IXB-1)*NMU 
J1  =  {JXB-1)»NMU 
DO  100  1=1, NMU 

100  Y(Il  +  I,Jl  +  n  =  X(  I  Ifl  ,  Jl-fl  )  1. 

C 

RETURN 

END 


SUBROUTINE  AMPAO 
C 

C  ON  NHM4/AMPA0 

C 

C  THIS  routine  FOURIER  ANALYZES  THE  QUAD- AVERAGED  SKY  RADIANCES 

C  RADSKY  =  N0(A,-)  TO  GENERATE  THE  DIRECT  BEAM  SPECTRAL  AMPLITUDE 

C  A0(A,-).  A0(A,-)  IS  THEN  TRANSMITTED 

c  Through  the  upper  boundary  to  get  ao(x.-),  ao(x,-)  is  then 

C  ATTENUATED  EXPONENTIALLY  TO  GET  AO(Y,-)  AT  ALL  DEPTHS. 

C 

C  COSINE  AMPLITUDES  ARE  IN  AOAM(I).  1  =  1.2 . NRHAT 

C  SINE  AMPLITUDES  ARE  IN  AOAM(I  ♦  NRHAT) 

C 

C  SPECTRAL  STOR.AGE  ARRAYS  MUST  BE  LOADED  WITH 

C  THAT1{A,X)  IN  THATl 

C  THAT2(A,X)  IN  THAT2 

C 

C  IN  This  routine,  /camp/  is  used  to  store  A0(Y,-),  A.LE.Y.LE.Z 

c 

PARAMETER(MXMU= 10 ,  MXPHI=24.  MXV=30) 

PARAMETER! MX L  =  MX PM  1/2,  MXRRTm  =  MXMU* (MXL^  1  )  , 

1  MXCRTH=MXMU» ( ( MXL+2) /2 ) ,  MX AMP= 2 • MxRRTm ) 

C 

COMMON/ CGR ID/  FMU ( MXMU ) , PH I ( MXPH I ) , Y ( MX Y ) 

common /CAMP/  AOAM(MXAMP) , DUMMY (MX AMP ) , AO YM ( MXAMP , MX Y ) 

COMMON/ CR  THAT/  ThATI(MXRRTh.MXCRTH), TmATZ { MXRRTH.MXCRTH) 
COMMON/CMl SC/  IMISC(20) 

COMMON/CwORK/  RADSKYCMXMU ,MXPmI ) 

L 
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NMU  =  IMISCCl) 

NPHI  =  IMISCC2) 

NL  =  IMISC{3) 

NV  =  IMISC(4) 

IDBUG  =  IMISC{9) 

NRHAT  =  IMISCCO) 

I F ( IDBUG . EQ . 2 )  THEN 

CALL  P2ARAV( THATl . 2*NMU. NMU .MXRRTm, 2 . ■ TMATK A , X)  IN  AMPAO ' ) 
CALL  P2ARAY(THAT2,  2»NMU,NMU,MXRRT(-t.2.  ■  TMAT2(A.X)  IN  AMPAO') 
CALL  P2ARAV(RADSKV .NMU.NPHI .MXMU.2,  RAOSKV  IN  AMPAO') 

ENDIF 

LOOP  OVER  L  AND  MU  TO  DEFINE  AO(A.-)  VIA  (4.8)  AND  (4.9) 
LOOP  OVER  THE  MU  BANOS  OTHER  THAN  ThE  POLAR  CAP 
DO  100  I=1,NMU-1 

DEFINE  THE  AMPLITUDES  FOR  EACH  L  VALUE  FROM  (4.8)  AND  (4.9) 

L  =  0  SPECIAL  CASE 
SUM  =  0. 

DO  310  J=1,NPHI 
310  SUM  =  SUM  <■  RADSkY(I.J) 

AOAM(I)  =  SUM/FL0AT(NPHI ) 

A0AM( I +NRHAT )  =  0. 


L  =  NL  SPECIAL  CASE 
Sum  =  0. 
no  320  J=1,NPHI 

320  SUM  =  SUM  +  RAOSKV  (  I  .  J  I  «COS(  FLOA '■(  nl  I  ♦PHI  I,  J  )  ) 
A0AM(NMU*NL^I )  =  SUM/FL0AT(NPHI ) 

A0AM(NMU*NL^ I ♦NRhAT )  =  0. 


0  .lt,  l  .lt.  NL  general  Case 


332 

330 


DO  330  L-  1  .  NL-  1 
SUMl  =  0. 

SUM2  =  0. 

00  332  J=1.NPHI 

SuMl  =  SUMl  +  RAOSKV (  I  , J ) ♦C0S( Float ( L ) »PHI ( J ) j 
SUM2  =  SUM2  ♦  RAi/iK  V  (  I  .  J  )  •  S  i  Ni  FlOA  I  (  L  y  *Pii:  (  J  )  ) 
AOAMCNMU*L^ 1 )  =  SUMI/FLOAT (NL ) 

A0AM(NMU*L»I  ♦  NRHAT)  =  SUM 2 / F L 0 A T I NL ) 


100  CONTINUE 

POLAR  CAP  special  CASE 

THE  COSINE  AMP  IS  JUST  THE  VALUE  OF  ThE  POLAR  CAP  QUAD- AVER AGED 
RADIANCE.  EQ.  (5.4) 

AOAM(NMU)  =  RA'DSkV  (  NMU  ,  1  ) 

A0AM(NMU  ♦  NRmAT)  =  0. 

DO  340  L= 1 . NL 
AOAM(NMU*L^NMu;  -  0. 

340  AOAM(NMU*L+NMU^NRmAT)  =  0. 

transmit  A0(A.  '  through  The  upper  boundary  via  6.55  TO  GET 

L  A0(X,-)  =  A0vMt»,l)  (IjOTE  In  0.55  yhAT  AOIX.-f)  -  0.  SEE  PAGE  137) 

C 

CALL  RFMPAK(AUAM.thAT1,AOYM. MXRRTh , NMU , NL ) 

call  RFMPAK(A 0 a MlNRHAT+l).THAT2.AUvMLNRHATfl.l). MXRRTH, NMU . NL ) 

C 

C  transmit  Au(K.  )  TO  all  LOiNER  V  lEvElS.  X  .GT.  V  .  GE  .  Z,  VIA  8.22 

c 

iRUW  =  0 
DC;  A'  O  l  =  c,nl 
DO  400  J  =  1  ,  NMly 
I  ROW  =  I  ROW  ^  1 

DO  400  I  V- 2 , N  Y 

temp  =  EXP((v(l)  -  Y( I  V ) ) /FMur  J  )  ! 

AO YM {  I  ROW ,  I y )  -  TEMP‘A0YM( IRCw.  1  ) 

400  AO YM (  I ROW^NRHA -  .  I Y J  =  T E MP ♦ A U YMH  I fiOw - NRHA T ,  1) 

C 

RE  I uRN 
END 
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subroutine  ampap 

ON  NHM4/AMPAP 

THIS  ROUTINE  DEFINES  A(A,+)  USING  6.56 

SPECTRAL  STORAGE  ARRAYS  MUST  BE  LOADED  WITH 
THATl(X.A)  IN  THATl 
THAT2(X,A)  IN  THAT2 
RHAT1(A,X)  in  RHATl 
RHAT2CA.X)  IN  RHAT2 

PARAMETER (MXMU= IQ ,  MXPHI=24.  MXY=30) 

PARAMETER (MXL=MXPHI /2 ,  MXRRTH=MXMU» ( MXL+ I ) . 

1  MXCRTH=MXMU*( {MXL>2)/2) ,  MX AMP= 2 ♦MXRRTH ) 

COMMON/CAMP/  AOAM(MXAMP) , AAP(MXAMP) , A VM ( MXAMP , MX Y ) , A VP ( MX AMP , MX Y ) 
COMMON/CRTHAT/  that KMXRRTH.MXCRIH) .THAT2(MXRRTH.MXCRTH) , 

1  RHATI(MXRRTH.MXCRTH)  ,RHAT...(MXRRTh.MXCRTH) 

COMMON/CMI SC/  IMISC(20) 

COMMON/CWORK/  AOAP(MXAMP)  . TEMP  1 (MXRRTH)  , TEMP2 ( MXRRTH )  . 

1  RHAT(MXRRTH,MXCRTH) ,THAT(MXRRTh.MXCRTH) 

DIMENSION  AXPIMXAMP) 
equivalence  ( AXP ( 1 )  , AVP(  1  .  1  )  ) 

NMU  =  IMISC(l) 

NL  =  IMISCC3) 

ID8UG  =  IMISCO) 

NRHAT  =  IMISC(IO) 

NCHAT  =  IMISC(ll) 

P  =  1  (COSINE  AMPLITUDES) 

IP  =  ! 

999  CONTINUF- 

IPOFF  =  ;.RHAT*(  IP-1) 

load  thatp(x,a)  into  that 
load  RhATPCA.x;  INTO  rhat 

IF( IP.EQ.  1)  then 
do  800  J=1,NChAT 
DO  800  1=1, NRHAT 
RHAT( I , J )  =  RHAf 1 ( I , J) 

800  THAT(I.J)  =  THATI(I.j) 

ELSE 

DO  802  J=l, NCHAT 
DO  802  1=1, NCHAT 
RhAT( I , j )  =  RhAT2( I , j ) 

802  THATd.j)  =  ThAT2(I,J) 

ENDIF 

IFdDBUG.GE  .  2)  THEN 
WR I TEl 6 , 3  10  )  IP 

CALL  P2AR A Y C That , 2 ‘NMU , NMU , MXRRTH , 2 , ' THATP( X , A )  IN  AMPAP') 
call  P2ARA V ( RhA T , 2 *NMU . NMu , MXRRTH, 2 . ' RHATP( a . X )  IN  AMPAP') 

ENDIF 
C 

C  evaluate  6.58  AND  SAvE  AOAP  FOR  WR I T 1 nG  ONTO  NUOUT 

V, 

L Al  L  RFMPAK ( A  «  L I  I  POP  F + 1  )  ,  ThA  T  .  T  E MP  1  , MXRR I H , NMU , NL ) 

CALL  PFMPAK(Ai:iAMdPOFF'»l).RHAT.TEMP2,MXRRTH,NMU,NL) 

DU  luu  1=1, NRhAT 

AOAP (  1  d  POFF )  =  TEMP2 ( I  ) 

100  AAP(  I  IPOFF  )  =  TEMPl(I)  »  TEMP2  d  ) 

C 

IF(IP.GTd)  RETURN 
C 

C  REPEAT  FOR  P  =  2  (SINE  AMPLITUDES) 

I  P  =  2 
GO  TO  999 

310  F0RMAT(1H1.'  SUBROUTINE  AMPAP.  p  ='.I2) 

C 

END 
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subroutine  AMPlNT 
ON  NMM4/AMPINT 

THIS  ROUTINE  FINDS  THE  AMPLITUDES  AIV,-)  AND  A ( V . f I  AT  AlL  INTERIOR 
DEPTHS  X  .lT,  Y  .LE.  Z  USING  7.6  AND  7.7  . 

PARAMETER(MXMU= 10 ,  MXPHI=24,  MXY=30) 

PARAMETER! MXL-MXPHI /Z.  MXAMP=2»MXMU*(MXL+1)) 

C 

COMMON/CAMP/  AAM(MXAMP) .AAP(MXAMP) . A VM { MXAMP . MX Y ) . A YP ( MXAMP . MXY ) 
COMMON/CRTR/  R YX ( MXMU , MXMU , MX Y ) . TXY ( MXMU . MXMU . MXY ) , 

1  R lYB ( MXMU , MXMU , MXY ) . R2YB(MXMU , MXMU , MXY ) 

COMMON/CMI SC/  IMISC{20) 

COMMON /C WORK/  TX YB ( MXMU , MXMU  J  , T EMP 1 c MXMU . MXMU )  , TEMP2 (MXMU , MXMU )  , 

1  RPYB ( MXMU .MXMU , MXV t 

C 

DIMENSION  AXM(MXAMP) 

EQUIVALENCE  ( AXM(  1 )  , AYM(  1 .  1  j  I 
C 

DATA  IDGT/10/,  Nu SCR  1 . NUSCR 2 . NU SuR J / 4o . 46 . 4 7 / 

C 

NMU  =  IMISC(l) 

NL  -  I  MI  SC ( 3  I 
NY  =  IMISCC4) 

IOBUG2  =  IMISC'Uy 
NRhAT  =  IMI SC (  lU  ) 

C 

REWIND  NUSl.Rl 
REWIND  NUSCR2 
REWIND  N  J  S  C  R  3 

r 

DO  lUU  l=0,NL 
C 

IFIIDBUuZ.Eu.Z’  '“’LN 

I  F  (  L  .  uE  .  1  .  jR  .  L  .GE  NL  -  1  ;  T-'EN 

IDBUG  =  2 

Eu5E 

I  D  B  ^.j  G  -  0 
F  N  0  I  F 

else 

IDBUO  -  lOBUl)/ 

END  I  F 

uUf^SET  =  Nf/ii*i. 

L 

C  READ  IN  RYX  =  R(^.X.L).  Txv  i  Tia.v.i)  AND  RPYB  =  RP(Y,B,L)  FOR  ALL 

C  /  levels,  for  ""hIS  l  value 

f. 

DO  3U0  Iv-l.Nv 

READ (  NUSCR  j  I  ;  '  Rv  A (  I  . J ,  1 V  I  .  ;  -  1  , NMu  I  .  u-  1  . NMU  ) 

readcnuScr?)  (  'Yxy,'i  ,j,r/;  ,i  =  ;.  nM'  ...  i  =  i .  nmu  ) 

R  E  A  D  f  N  ij  S  L  R  .i  I  1  ■  R  1  »  B  (  I  ,  J  ,  I  »  )  ,  I  -  1  .  N'vKj  )  ,  J  -  1  .  fiMu  ) 

i  'S.!  READ  (  NuSCR  •)  ,  I  .' /B(  :  .  J  .  ;  V  .  ,  I  =  !  .  rJMi!  )  ,  j=  1  .  NMli  ) 

L 

IF(IDBUU.liE,2l  i'^EN 
WR  I  TE  (  6 , 3  I'j  '  ._ 

■  All  L'  ar  a  'I  V  ■■  I  .  NMi,  rj  V  .  M « Mij  .  M  «m:  .  .  L  .  '  R  (  v  ,  x  .  l  )  '  ] 

C  A  L  u  P3  AR  A  Y  '  T  /  ■  .  NMu  .  NMu  .  '  ,  T'-'-Mu  .  V  .  2  .  T  (  X  ,  Y  .  L  )  '  ) 

'.  A  i_  u  P  3  A  K  A  V  '  L  ;  '  r;  .  Nf/.  j  .  NMu  .  N  y  .  M  j*  TV.  .  M  x  Mil  .  u  .  R  1  I  Y  .  B  ,  L  )  ) 

A  .  ^  3  Ai'  /■  /  I  I'  j  V  e  .  N'.'  .  NM  ^  .  iN  .  ,  M  Ar.-  I  .  M  XMU  .  2  .  '  R  1  (  Y  .  6  ,  i.  )  ’  ) 

END  I  F 

:  N  ;  '  ;  ~  ;  LF  ;  r.r  amp.  ;  ■  ..;t  u 


')  ;U  ■  ,N  -  !  N  .P 

(. 

C  u  A  D  R  P'  Y  H  I  OP  p  R  f<  E  N  T  p  A  I  1^  t 

I  F  I  ;  R  .  1  U  .  1  I  I  P  r  N 

I  IP  J  ■  ■  ;  OF  u;  ■■ 

p'.pO  ms  I  Y  -  1  ,  r,  Y 

'i'u  1  pp  ,  -  ;  .  NM 

o<o  ,j‘,  I  - :  .  NM. 

/OS  p  R  Y  H !  :  ,  . .  I  Y  )  --  -  I V  B  (  :  i .  i  .  i 

E  ..  u  L 
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rOFSET  =  LOFSET  +  NRMAT 
DO  206  IV=1,NV 
DO  206  J=1.NMU 
DO  206  I=1,NMU 

206  RPVBd.J.IV)  =  R2VB(I.J.IV> 

ENDIF 

C 

C  COMPUTE  THE  AMPLITUDES  AT  EACH  Y  LEVEL 

C 

DO  102  IY=2.NY 

IF ( IDBUG. EQ. 2 )  WRIT£(6,311)  lY.IP 
C 

C  COMPUTE  TXYB  =  TP(X,V,B.L)  USING  b.33 

C 

C  COMPUTE  TEMPI  =  I  -  RP(Y.B)  •  R(Y.X) 

DO  210  1=1, NMU 
DO  210  J=1.NMU 
SUM  =  0 . 

DO  211  K=1,NMU 

211  SUM  =  SUM  »  RFYB {  I  , K . I  V) ♦RVX( K , j .  I  V) 

DElT  =  0. 

I F (  !  . EO . J )  DElT  =  1  . 

210  TEMPl(I.J)  =  OELT  -  SUM 

I F (  I DBUG. EO . 2 )  call  P2ARAY { TEMP  1 . NMU . NMU , MXMU , 2 
1  -  I  -  RP(Y.B)  *  R(V,X)  '  ) 

C 

C  INVERT  I  -  RP(Y,a)  »  R(V,X) 

call  LINVIFCTEMPI, NMU .MXMU , TEMP2 . I DGT . TXYB . 1 ER ) 
IF( IDBUG. EQ. 2)  CALL  P2ARA Y ( TEMP2 , NMU , NMU . MXMU . 2 
1  ■([  -  fiP(Y,B)  ♦  R(Y,X))  INVERSE') 

C 

C  COMPUTE  SCRIPT  TP(X.V,B.L) 

DO  220  1=1, NMU 
DO  220  J=1,NMU 
SUM  =  0 . 

DO  221  K=1,NMU 

221  Sum  =  Sum  t  TXY (  I  , K , I Y ) ♦T£MP2( K , J ) 

220  TXVB ( I , J )  =  SUM 

I F ( I DBUG . EQ . 2 )  call  P 2 AR A Y ( T X VB . NMu . NMu . MxMU . 2 , 
1  ' SCRIPT  TP(X . V .B , L ) ' ) 

C 

C  COMPUTE  AP(Y,')  using  7.6 

C 

DO  2  30  .j=l,r;MU 
SUM  =  0. 

C 

DO  231  K-l.NMU 

231  SUM  =  Sum  +  AXMi  I  OFSET  )  ♦  TXYB(  X  ,  J  ) 

230  AYM( J* lOFSET  ,  I  V )  =  SUM 

C 

C  COMPUTE  A(Y.<-)  USING  7.7 

C 

DO  240  .1=  1.  NMU 
SUM  =  u  , 

C 

DO  24  1  K-l,rjMu 

>^41  ^UM  =  SUM  AvMl^<■^IOFS6T.IV)••Rp¥B^x,J.iY) 

240  AVP  (  1  OF  SET  .  1  O  =  SUM 

C 

102  CONTINUE 
C 

C  REPEAT  FOR  ThE  'jINE  AMPLITUDES.  IP  =  2 

C 

I P  =  IP  -  1 
IF(IP.LT.3)  GC  to  999 
C 

lOU  CONTINUE 
C 

I F ( IDBUG . EQ . 2 1  TuEN 

call  P2ARAV(AYM,2»NRHAT,NY.MXAMF',2.  'AIY.-)  '  ) 
CAlL  P2ARAV(AVP,2*NRHAT,N¥,MXAMP.2. 'A(Y,+)') 
ENDIF 

310  FORMATllHl,'  SUBROUTINE  AMPINI.  l  =’.I3) 

311  FORMAT! IHO.'  IV  =',I2.3X.IP  =',I2) 

C 

RETURN 

END 
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Subroutine  ampx 

c 

C  ON  NHM4/AMPX 

C 

C  THIS  routine  computes  A(X,-)  AND  A  ( X  . )  USING  7.3  AND  7 . 5B 

C 

C  spectral  STORAGE  ARRAVS  MUST  BE  LOADED  WITH 

C  THATKA.X)  IN  THAT! 

C  THAT2(A.X)  IN  THAT2 

C  RHATKX.A)  in  RHATl 

C  RHAT2(X,A)  IN  RHAT2 

C 

PARAMETER  (MXMU=  10  .  MXPMI  =  24,  MXV::30) 

PARAMETER (MXL=MXPHI /2 ,  MXRRTH=MXMU* { MXLf 1) , 

1  MXCRTH=MXMU*( (MXL»?)/2) .  MXAMP= 2 ’MXRRTn ) 

C 

COMMON/CAMP/  AOAM(MXAMP) .AAP(MXAMP) . A YM ( MXAMP , MX V ) . A VP ( MXAMP . MXV ) 
COMMON/CRTHAT/  THAT  1 ( MXRR TH . MXCRTH )  , THAT2 ( MXRRTH . MXCRTH)  . 

1  RHATKMXRRTH, MXCRTH)  ,  RHA  T  2  (  MXRRTh  .  MXCRTh  ) 

COMMON/CMI SC/  IM:SL(20) 

COMMON/CWORK/  WORK(MXMU,MXMU) . TEMP ( MXRR TH , MXCR TH ) , 

1  RhAT( MXRRTH. MXCRTH), THA T ( MXRR Th . MXCRTH ) , R1XBL(MXMU , MXMU , 0 :MXL ) . 

2  R2XBL I MXMU , MXMu . 0 : MXL ) . R XBl ( MXMu , MXMu . 0 : MXL ) 

C 

DIMENSION  AXM( MXAMP ), AXP ( MXAMP ) 

equivalence  ( AXMi  1  )  , AVM(  1  .  1 )  )  . { AXP(  1 )  . AYP(  1 .  1 )  ) 

NMU  =  I  MI  SC :  1  1 
Nl  =  IMISCfS) 

NY  =  IMISC(4j 
KINY  =  !MI SL ( 8  ) 
lOBUG  =  IMI  Sl'(  9  ■ 

NRHAT  =  IMI SC( iu) 
nchat  =  im: SC ( ;  ;  j 
NUSCR3  •  IMI sc  ■") 

IE  yen  =  (Nl->-2)/2 
I  ODD  =  (r<L*l)/2 

C 

C  READ  RKX.e.L-  an:.  S2(X.B.I  )  from  scratch  file  NUSCR3 

C 

REWIND  NUSt Rj 
DO  lUO  ;.  =  0,N^ 

C 

C  READ>-Xl-Ev'E.. 

READ^NuSCRi)  !iR1xBl(1,J.l).I=.1,  NMu  i  .  j  =  1  .  NMu  ) 

READtNuSCRS)  i  CR2X8L(I  .J.l)  ,1  =  1,  NMU  )  ,  ,;  =  1  ,  NMU  ) 

C 

C  SKIP  O^mER  V  .t/E_S  FOR  this  l  yAlUE 

DO  100  IV=2,NV 
REA0(NUSCR3)  Di'MREC 
100  READ(,NuSCR3)  D.^MREC 
I F { I DBuG . EQ . 2  )  ThEN 

call  PSARAY ( R 1 > 3l , NMU . NMU , Nl » I . M^MU , MxMU . J ,  ' R  I  ( X , B , L )  IN  AMPX') 
Call  P3ARA Y ( R2 ^Bl , NMu , NMU . Nl *  1  , MXMu , MXMu . 2 ,  ' R2 ( X , B , L )  IN  AMPX') 
ENDI  F 

c 

L  initialize  FUr  r  ^  1  (COSINE  AMPLITUDES) 

I, 

I  P  =  1 

lOFSET  =  0 

C 

999  LONIiNuE 

C 

c  lOAlj  R"1atp(a,a  intu  rha^  and  R'pix.b.li  Into  Rxbl 

r 

I  pp  (  I  P  ,  EO  .  1  ;  Tr.EN 
DO  800  j=1,NChai 
DO  aOij  I  =  i,NfiriAr 

800  RhAT  (  I  ,  J  )  =  R-'AT  1  (  I  ,  j  ) 

DO  801  l=0,Nl 

DO  80  1  J=  1  , NMU 
DO  801  ! L 1 , NMi 

801  RXBLfl.j.L)  =  RIXBLII.J.L) 

Else 
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DO  802  J=1,NCHAT 
DO  802  I=1.NRHAT 

802  ftMAT(I.J)  =  RHAT2(I.J) 

DO  803  L=0.NL 

DO  803  J=1,NMU 
DO  803  1=1. NMU 

803  RXBLd.J.L)  =  R2XBl(1,J.L) 

ENDIF 

IF(IDBUG.EQ.2J  TmEN 
WRITE(6,901)  IP 

CALL  P2ARAV(RhAT , 2*NMU.NMU.MXRRTM. 2 . ■ RHATPIX, A)  IN  AMPX ' ) 

ENDIF 

COMPUTE  TEMP  =  RP{X,B)  ♦  RHATP(X.A)  AS  NMo  BV  NMU  BLOCKS 

DO  200  L=Q,NL 
IROFF  =  NMU»L 
NCOL  =  lODD 

I F (M0D( L , 2 ) . EQ . 0)  NCOL  =  lEVEN 
00  200  IR=1,NC0L 

EXTRACT  AN  NMU  BV  NMU  BLOCK  FROM  RHATP 
ICOFF  =  NMU*(IR-1) 

DO  210  1=1, NMU 
DO  210  J=1,NMU 

210  WORKd.J)  =  R(-fATd•^IROFF.  JflCOFF) 

multiply  RP(X,a,L)  TIMES  THIS  BLOCK  AND  STORE  THE  RESULT  IN  RHAT 

DO  212  1=1, NMU 
00  212  J=1.NMU 
SUM  =  0. 

DC  214  K=1,NMU 

214  SUM  =  Sum  ♦  RxBl ( I , K , L ) ‘WORK ( K . j ) 

212  RnATd->-IROFF  .  JfICOFF  )  =  SuM 
200  CONTINUE 

RhAT  NOW  CONTAINS  RP{X.B)  •  RmATP 

COMPUTE  THE  inverse  FOR  (7.3)  OSiN'j  TmE  APPROXIMATION  (7.4) 

(I  <■  X)  INVERSE  =  I  X  X**2  ^  ...  t  a»*KINV 

I F ( I DBUG . EQ . 2 )  CALL  P2 AR A Y { RHA T . 2 » NMU , NMU . MXRR TH , 2 , 

1 ' RP( X , B )  *  RHA ' P ■ ) 

CALL  ADIPAK(RHAT,TEMP, MXRRTH . NMU , NL ) 

DO  250  K  =  2 , K I N  7 

CALL  FFMPAK(TEMP,RHAT, THA T . MXRR Th . NMU .  f<L . WORK ) 

250  CALL  ADI PAK ( ThA T , TEMP .MXRRTH . NMU . NL ) 

TEMP  NOW  CONTAINS  TME  INVERSE 
IF( IDBUG.GE. 1 )  then 
DO  804  I=1,NRHAT 
DO  804  J= 1 , NCmAT 

804  RHAT(I.j)  =  -RMAT(I,J) 

call  ADI PAK ( RhAT .THAT, MXRRTH, NMU . NL ) 

CAli.  FFMPAK  (TEMP,  ThA  T, RHAT.  MX  RRTH.  NMu  .  NL  .  WORK  ) 

call  P2ARA Y ( RhAT , 2*NMu , NMU .MXRRTm . 2 , • IDEnTI TY  CHECK  IN  AMPX’) 
ENDIF 

load  TMATP(A.X)  INIO  that  and  compute  script  T(A,X,B)  By  6.33 

I F ( I P . EO . 1 )  TMEN 
DO  810  J=1,NC>^at 
DO  810  I=1,NRMAT 
810  THAT(I.jj  =  THATKI.j) 

else 

DO  812  J=l, NCMAT 
DO  812  1=1, NRMAT 
812  ThAT(I,J)  =  TmAT2(I.J) 

ENDIF 

IFdDBUG.EQ.  2)  THEN 

call  P2ARA V( that , 2*NMU . NMU . MXRRTH . 2 . ' THATP( a , X )  IN  AMPX ' ) 
call  P2ARAY ( temp . 2*NMU . NMU .MXRR th . 2 , ■ ( 1  -  RP*RHATP)  INVERSE) 

ENDIF 


80 


non  nnnnn 


§5.  PROGRAM  4 


CALL  FFMPAK(THAT . TEMP . RHAT . MXRRTH , NMU . NL , WORK) 

IF ( IDBUG . EQ . 2 )  CALL  P 2 AR AV ( RHAT . 2 »NMU . NMU . MXRRTH , 2 , 

1  ' SCRIPT  T( A .X. B) - ) 

RHAT  NOW  CONTAINS  SCRIPT  T{A.X.B) 

COMPUTE  AP(X,-)  BY  (7.3) 

call  RFMPAK{A0AM(I0FSET+1)  .RHAT . AXM (  I  OF SET* 1 )  .MXRRTH . NMU . NL ) 

COMPUTE  AP(X.->-)  BY  7 . 5B 

DO  400  L=0.NL 
LOFSET  =  NMU»L 
DO  400  1=1. NMU 
SUM  =  0. 

DO  402  K= 1 . NMU 

402  SUM  =  SUM  +  AXM(  K-M.0FSET-<-I0FSET  )  *RXBl  (  K  .  I  .  L  ) 

400  AXP( I +LOFSETf IOFSET )  =  SUM 

I F (IDBUG . GE . 2 )  THEN 

CALL  P2ARAY(AOAM(IOFSET*-l).l.  NRHAT  .1.2.  AOIA.-)  '  ) 

CALL  P2ARAY(AXM(IOFSET»l).l .NRHAT .1.2,'A(X.-)) 

CALL  P2ARAV(AXP(IOFS£T«-l).l.  NRHAT  .  1.2.'A(X.f)  ) 

ENDIF 

C 

I F ( I P . GT .  1  )  return 
C 

C  REPEAT  FOR  R  =  2  (SINE  AMPLITUDES) 

IP  =  2 

lOFSET  =  NRHAT 
GO  TO  999 

901  FORMAT!  IMl,'  SUBROUTINE  AMPX ;  P  --,12) 

C 

END 


Subroutine  botmbc(l) 

c 

C  on  NHM4/B0TMBC: 

C  this  routine  (-.imputes  the  discrete  spectral  RHATZB  =  RHATl(Z.B.L) 

C  FOR  THE  DESIRED  BOTTOM  BOUNDARY  CONDITION. 

C 

C  IF  IBOTM  =  0.  USE  3.26.  5.47.  5.50.  5.51  AND  5.53 

C  IF  IBOTM  =  1.  SET  UP  AND  SOLVE  ThE  EIGENvAuUE  PROBLEM  10.2 

C  AND  then  use  10. B  and  10.9  FOR  RHAT ( Z . I NF I N I T Y ) 

C 

PARAMETER ( MXMU=  10 ,  MXPHI=24.  MXY  =  30) 

C 

COMMON/CBOTBC/  RHATZB(MXMU.MXMU) 

COMMON /CGR ID/  FMU ( MXMU )  . PH  I  ( MXPhI  )  . Y ( MXY )  . BNDMU( MXMU )  , 

1  BNDPHI  (MXPhI  )  .OMEGA (MXMU) 

COMMON /CM  I  SC /  IMI SC ( 20)  . FMI SC ( 20 ) 

C 

NMU  =  IMI SC(  1  ) 

NPHI  =  IMI SC ' 2 : 

I BOTM  =  IMI SC ( 12 ) 

RMINUS  =  FMI SC i  14 ) 

CONST  =  rminus/fmi SC ( 1 ; 

C 
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IF(IBOTM.EQ.O)  THEN 
C 

IF(L.EQ.O)  THEN 

FOR  A  MATTE  BOTTOM  AND  L . tQ . U ,  GET  THE  GEOMETRIC  R(Z,B)  BV  3.26. 

RHAT  ELEMENT  BY  5.53.  RHAT  ARRAY  BV  5.50 

DO  100  IR=1.NMU 

YAL  =  FlOAT(NPHI) «C0NST*FMU( IR ) «OMEGA( IR ) 

SPECIAL  CASE  FOR  POLAR  CAP  QUAD 
IF( IR . EQ . NMU3  VAL  =  C0NST» FMU ( NMU ) ‘OMEGA ( NMU ) 

00  100  10=1. NMU 
100  RHATZBC IR , lUj  =  VAL 

else 

FOR  MATTE  BOTTOM  AND  L  .  GT  .  0  .  RHATKZ.B)  =  0  BY  5 . 53B 
00  102  IR=1.NMU 
DO  102  IU=1.NMU 
102  RHATZBI IR. lU)  =  0. 

ENDI  F 

Else 

SET  UP  AND  SOLVE  THE  EIGENVALUE  PROBLEM  FOR  R ( I NF I N I T V . L ) 

EIGENR  sets  RhAIZB  =  R(INF.L) 

IF  RUNS  ARE  BEING  MADE  WITH  A  MATTE  BOTTOM  ONLY,  THE  CALL  TO  EIGENR 
CAN  BE  COMMENTED  OUT  TO  PREVENT  LOADING  ThE  LARGE  IMSL  ROUTINES  IT  CALLS 

call  EIGENR(L) 

ENDI  F 
RETURN 
C 

END 


SUBROUTINE  DR T AB ( NR T AB . VNOW . R T .OERIV) 

C 

C  ON  NHM4/DRTA8 

C 

C  THIS  subroutine  evaluates  DERIV  =  D(RT),'DY  AT  Y  =  YNOW  (THE  RIGHT 

C  HAND  SIDE  OF  6  43.  6.44  AND  6.48)  FOR  USE  BY  THE  IMSL  ROUTINE  DVERK 

C 

C  recall  THA ,  KYX  AND  TXV  ARE  STORED  IN  RT : 

C 

C  RYXtI.J)  =  RT(I  (J-1)*NIJ) 

C  TXVd.J)  =  RT(I  1-  (J-l)»NIJ  *  NIJ’NIJ) 

C 

PARAMETER(MXMU=10,  MXSIGV=3) 
real  RT(NRTAB) , DERIV(NRTAB) 

DIMENSION  WORK ( MXMU . MXMU ) . RHOY ( MXMu , MXMU ) , T AU V ( MXMU , MXMu ) 

COMMON/ CRTSI 0/  RHOHA T ( MXMU . MXMu , MxSIGY) . TAUHAT(MXMu , MXMU . MX SI  GY ) 
COMMON/CSIGV/  YSIG(MXSIGy) 

COMMON/CMI SC/  IMISC(20) 

C 

NMU  =  IMISC(  1  ) 

NSIGY  =  IMISC(5) 

IDE  =  IMISC( 13j 
NSO  =  NMU*NMU 
C 
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determine  RHOHAT  and  tauhat  at  the  current  V  value 
I F (NSIGV . EQ . 1  .or.  VNOw. LE . VSIGl 1) )  THEN 

THE  WATER  IS  UNIFORM,  OR  VNOW  IS  AT  OR  ABOVE  THE  FIRST  DEPTH 
where  sigma  is  KNOWN 

DO  50  J^^l.NMU 
DO  50  I=1,NMU 
RH0y(I,J)  =  RHOHAT ( I , J , 1 ) 

50  TAUVd.J)  =  TAUHATd.J.I) 

ELSEI F ( VNOW . GE . VSIG(NSIGV) )  THEN 

VNOw  IS  AT  OR  BELOW  THE  LAST  DEPTH  WHERE  SIGMA  IS  KNOWN 

DO  52  J= 1 , NMU 
DO  52  1=1, NMU 

RHOVd,J)  =  RHOHAT  (  I  ,  J  ,  NSIGV  ) 

52  TAUV(I.J)  =  TAUHAT( I . J.NSIGV) 

ELSE 

define  RHOHAT  AND  TAUHAT  BV  LINEAR  INTERPOLATION  OF  THE  VALUES  FROM 
THOSE  DEPTHS  WHERE  SIGMA  IS  KNOWN 

00  55  JV=2, NSIGV 
IF(VNOW.LT.VSrG( JV) )  GO  TO  56 

55  CONTINUE 

56  DV  =  (VNOw  -  VSI G{ JV- 1 ) ) / ( VSIG( JV J  -  vSIG(JV-I)) 

DO  58  J=1,NMU 
DO  58  1=1. NMU 

RHOVd.J)  =  (1.0  -  DV ) ’RHOHAT (I . J . JV- U  ’  D V  * RHOHAT ( I  , J , J V ) 

58  TAUVd.j)  =  (1.3  ■  DV  ) ’TAUHAT  (  I  ,  J  ,  JV-  1)  ■*  D  V  •  TAUHAT  (I  ,  J  ,  J  V  ) 

ENDI  F 

COMPUTE  K  =  TAUv  »  RhOV’RVX 

DO  lOU  dl.NMi; 

DO  100  J=1.NMU 
WORK ( I  . J )  =  TAuV( I  , J  ) 

DO  100  K= 1 , NMU 

100  W0RK(I,J)  =  wURk'I.j)  RHOVd  .k)*RT(K  (J-l)’NMU) 

COMPUTE  D(RVX)/OV  BV  EQ .  6.43 

DO  200  I  =  1,NM1J 
DO  200  J=1,NMU 
TEMPI  =  0. 

TEMP2  =  0. 

DO  201  K=1,NMU 

TEMPI  =  TEMPI  »  RT(I  +  ( K -  1 ) ’NMU ) ’WORK ( K . J ) 

201  TEMP2  =  TEMP2  T  AUV  (  I  .  K  ) ’RT  (  K  (J-1)»NMU) 

200  DERIV(I  +  (j-ll’NMU)  =  RHOV{I,J)  »  TEMPI  +  TEMP2 

IF(IDE.NE.2)  ^-EN 

COMPUTE  D(TxV)/DV  BV  EQ.  6  44 

DO  300  1=1, NMU 
DO  300  J  =  l.NM.j 
temp  1  =  0. 

DO  30  1  K--l,NM.j 

30  1  TEMPI  =  TEMPI  Rdl  +  (K-1)*NMU  »  NSU  J  ’  WORK  (  K  .  J  ) 

300  DERIvfl  *■  (j'll’NMU  -  NSQ)  =  TEMPI 
L 

Else 

c 

C  CHANGE  OF  SIGN  TO  GET  EQ .  6.48 

DO  700  1  =  1, NR  TAB 
700  DERI V(  I  I  =  -QEPI v(  I  ) 

ENDI  F 

RF ’URN 
END 
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subroutine  EIGENR(L) 

c 

C  ON  NHM4/EIGENR 

C 

C  this  routine  sets  up  and  solves  the  EIGENMATRIX  problem  KE  =  EL 
C  AS  DESCRIBED  IN  SECTION  IQ. 

C  THE  SUBMATRICES  EP  =  E(»)  AND  EM  =  E(-)  ARE  EXTRACTED,  AND 

C  R( INFINITY ,L)  =  -E(-)  ♦  E(+)INVERSE  IS  COMPUTED. 

C 

C  THE  ASYMPTOTIC  RADIANCE  DISTRIBUTION  AND  ASSOCIATED  QUANTITIES 

C  ARE  ALSO  FOUND  USING  FROMULAS  FROM  TECH  MEMO  ERL-PMEL-76. 

C 

C  IF  L  =  0.  THE  FULL  RHO  AND  TAU  MATRICES  ARE  USED  TO  DEFINE  K 

C  IF  L.GT.Q,  row  NMU  and  COLUMN  NMU  OF  RHO  AND  TAU  IS  ZERO.  AND 

C  thus  is  OMITTED  FROM  K  (SEE  PAGE  174) 

C 

PARAMETER (MXMU= 10 .  MXPHI=24.  MXY  =  30,  MXSIGY=3) 

PARAMETER (MXMU2- 2 ‘MXMU ,  MXMUSQ=MXMU»MXMU ) 

C 

DIMENSION  IP(MXMU2) , E V AL S ( MXMU2 ) .EIGVCMXMU) 
complex  WEV(MXMU2) 

C 

COMMON/ CGR ID/  FMU(MXMU)  .PHI (MX PH I  )  . VOuT (MXY  j  , BNDMU (MXMU )  , 

1  BNDPHI (MXPHI ) ,OMEGA(MXMU) , OELTMU ( MXMU ) 

COMMON/ CRTS  I G/  RHOhAT (MXMU .MXMu .MxSIGY )  . T AUHAT ( MXMU , MXMU , MX SI  GY ) 
COMMON/CSIGY/  Y SIG (MXSIGY ) .AlBESS(MXSIGY )  , TOT A L S ( MXS I G Y  ) 
COMMON/CBOTBC/  RHA T ZB ( MXMU , MXMu ) 

COMMON/CMI SC/  IMISC(20) 

common/ CWORK/  WERK(MXMUSQ, 12 ) .RP INF (MXMu ) .RMl NF (MXMU ) , WORK( 1 ) 

C  ARRAY  WOHK(l)  MUST  HAVE  4*NMU*  ( NMU*- 1  )  WORDS  AVAILABLE 

C 

DIMENSION  FP(MXMU,MXMU)  . FM( MXMU . MXMU )  ,  TEMP  1 ( MXMU , MXMU )  , 

1  TEMP2(MXMU ,MXMU) , EMNV { MXMU . MXMU ) 

C 

DIMENSION  AK{MXMU2 , MXMU2) , EMK ( MXMU 2 , MXMu2 ) , EP(MXMU ,MXMU ) , 

1  £M{MXMU .MXMU ). EPNV(MXMU .MXMU ) 
complex  ZEV(MXM^2 ,MXMU2) 

C 

equivalence  (WERK(1.1),AK(1.I)).(WERK(1,5).ZEV(1,1)) 
equivalence  ( wERk (  1  .  I  )  , EMK (1,1)1.  ( wERK( 1.5),£P(1,1)), 

I  (weRK(l,6),EM(l.l)),(wERK(1.7) , EPNV( 1.1)) 

NMU  =  I  MI  SC (  1 ) 

NSIGV  =  IMISC(5) 

IDBUG  =  IMISCO) 

ALPHA  =  TOTAlS(NSIGV) /ALBESS(nSIGy ) 

L 

C  DETERMINE  THE  ARRAY  SIZES 

if(l.eo.o)  then 

M  =  NMU 
ELSE 

M  =  NMU  -  1 
ENDI  I- 
M2  =  2»M 
C 

C  INITIALIZE  the  K  matrix.  USING  B.21  UR  5.24  IN  6.H 

C 

DO  100  1-1, M2 
DO  100  J=1,M2 
I F ( I . LE . M )  IHLN 

IF(J.LE.M)  AkiI.J)  =  -TALIHAT(  I  ,  j  .nSIGY  I 
IF(M.LT.,j1  AKIl.JI  =  RhOHAT  1  I  .  j-M.l  SIGV  ) 

ELSE 

IF(j.L£.M)  Ak(I,J)  =  -RHOHAT ( I -M . J , NS  1  Gy ) 

IF;m.lT.J)  AKil.j)  =  T AUHAT (  I -M  .  J -M , NSl GY  ' 

ENDI  F 

lOU  CONTINUE 

I F ( I DBUU . G7 . 1 /  call  P2ARA V ( AK , M2 , M2 . MXMU2 . 2 , 

1  'K  MATRIX  FROM  SUB  EIGENR) 

C 

C  FIND  eigenvalues  AND  EIGENVECTORS  OF  K 

C 

CALL  EIGRF(AK,M2, MXMU 2 , 2 . WEV . ZEV , MXMU 2 . WORK , I ER ) 

I F ( IDBUG . GT . 1 )  then 
WRITE(6,301)  ( WEV( I ) , I = 1 .M2) 

WRITE(6.304)  wORK(l) 

ENDI  F 
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SORT  POSITIVE  eigenvalues 

KPOS  =  0 
DO  600  1  =  1  .M2 
TMP  =  WEV( I ) 

IF(TMP. LT . 0. )  GO  TO  600 
KPOS  =  KPOS  -I-  1 
EVALSIKPOS)  =  TMP 

600  continue 

CALL  VSRTA(EVALS.KPOS) 

DEFINE  ORDERED  EIGENVALUES 
DO  601  1=1. KPOS 
EIGV( I J  =  EVALSI I ) 

601  £VALS(  I +KPOS )  =  -EVALSd) 

CONSTRUCT  permutation  MATRIX  IP  BY  COMPARING  WEV  AND  EVAlS 
DO  610  1=1 .M2 
TMP  =  WEV( I ) 

DO  610  J= 1 , M2 

I F ( A0S( EVALS ( J )  -  TMP) . LT . 1 . E-8 )  IP(I)  =  J 

610  continue 

IF(  lOBUG.GT  .  1  )  1%R  I  TE  (  6 . 68  1  )  (  J  ,  I  P  (  J  )  .  J  =  1  .  M2  ) 

IF(l.£Q.O  .or.  ID0UG.GT.O)  V»RI  TE  (  6 . 680  )  l  .  {  E  I  GV  (  I  )  ,  AL  PHA  •  E I GV  (  I  )  . 

1  1=1 .M) 

DEFINE  REAL.  ORDERED  EIGENVECTOR  MATRIX  EMK 

DO  62'-'  J=1.M2 
JJ  =  IP(J) 

DO  620  1=1. M2 
620  EMK{ I  . j  j )  =  ZEVl  I  . J) 

IF( lOeuG.GT. 1)  (All  P2AR A V ( EMK . M2 , M2 . MXMu2 . 2 . 

1  'SORTED  EIGENVECTORS') 

C 

C  extract  TmE  SUBMATRICES  EP  =  E(+)  AND  EM  =  -E(-) 

DO  630  I = 1 .M 
DO  630  J=1.M 
EP  I  I  ,  J  )  =  EMK  I  ,  j  ) 

630  EM( I  . J )  =  -EMK (  I -M . J  ) 

IF ( I OauG . GT . 1 j  iHEN 

call  P2ARAV(£P.M,M, MXMU . 2 .  ■ E( *  )  '  ) 
call  P2ARAy(£M.M.M,MXMU.2.  '-£(-)  '  ) 

ENDIF 

L 

C  INVERT  E(+)  AND  DEFINE  RIINFINII,).  USING  10.8  OR  10.9 

C 

IDGT  =  6 

call  L  I  NV  2f-  (  £P  ,  M  ,  MxMU  .  E'^’N  V  .  I  dot  .  work  .  I  ER  ) 

CAL.-  VMULF  F  (  EM  ,  EPNv  .  M  .  M  .  M  ,  MXMU  .  MXMU  ,  RHATZB  ,  MXMU  .  I  ER  ) 

(  fill  The  lAS'  '• -iw  AND  LAST  COLUMN  OF  RtiAT(Z.B)  WITH  ZEROS  IF 

C  L . GT , 0 

I F ( L . GT . 0 )  Then 
DO  649  I = 1 . NM  : 

RHATZB ( NMU . I )  =  0 . 

649  RHATZB  C  I  . NMU )  =  0 . 

ENDIF 

L 

C  CONSTRUCT  The  fi.f)  and  Fi-)  MATRICES  AND  GET  THE  ASYMPTOTIC 

C  radiance  distribution  USING  76/18.2.  NOTE  THAT  RADINF{<-)  IS  OBTAINED 

L  FROM  F(-)  and  'hat  RADINFI-)  IS  OBTAINED  FROM  F(+). 

C 

IF(L.tO.O)  Then 
C 

C  EM  IS  -E(-) 

DO  652  J= 1 . NMU 
DO  65  2  I  =  l.NMl.i 
652  EM(  I  . J  j  =  -EM(  1  .  J ) 

L 
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IDGT  =  6 

call  L1NV2F(EM. NMU ,MXMU . EMNV . IDGT .WORK . I £R ) 

I F ( IDBUG . GT . 1 )  THEN 

CAlL  P2ARAV(EPNV. NMU . NMU , MXMU ,2,  'E(»)-l  -  ) 

CALL  P2ARAV ( EMNV , NMU , NMU . MXMU .2.'El-)-l-) 

ENDIF 

CALL  VMULFF ( EM , EPNV , NMU , NMU . NMU . MXMU , MXMU .TEMPI .MXMU . I ER ) 

CALL  VMULFF ( TEMP  1 . EM . NMU . NMU . NMU .MXMU .MXMU . TEMP 2 .MXMU . I ER ) 

DO  650  1=1. NMU 
00  6b0  J=1,NMU 

650  TEMPl(I.J)  -  EP(I,J)  -  TEMP2(I.J) 

C 

IDGT  =  6 

CALL  LINV2F ( TEMP  1  , NMU . MXMU . FP .  IDGT .WORK . lER ) 

CALL  VMULFF(EP. EMNV. NMU , NMU . NMu . MXMU . MXMU .TEMPI .MXMU . I ER ) 

CALL  VMULFF ( TEMP  1 . EP .NMU . NMu . NMU . MXMU . MXMU . TEMP 2 .MXMU .  I ER ) 

DO  651  1=1. NMU 
DO  651  J=1.NMU 

651  TEMPld.J)  =  EM(I.J)  -  TEMP2(I.J) 

IDGT  =  6 

call  LINV2F(TEMP1, NMU .MXMU . FM. IDGT .WORK . I ER ) 

normalize  the  nadir  ASVMPTOTIC  radiance  TO  ONE 
ANORM  =  1 . 0/FP(  1  . NMU ) 

WRITE(6,665) 

DO  656  1=1, NMU 
RPINF(I)  =  AN0RM»FMC 1 . I ) 

RMINF ( I )  =  AN0RM»FP( 1 . I ) 

656  WRIT£(6.657)  I . RM I NF { I ) . RP I NF ( I ) 

USE  the  ASVMPTOTIC  RADIANCE  DISTRIBUTION  TO  GET  THE  ASVMPTOTIC 
D+ .  D-.  R-.  EPS*  AND  EPS- 

ACCUMULATE  IRRADIANCE  SUMS 
SHP  =  0. 

SHM  =  0 . 

CHP  =  0 . 

CHM  =  0  . 

DO  670  1=1, NMU 
DMU  =  DEL  TMU(  I  ) 

SHP  =  SHP  *  RPINF(I)*0MU 

SHM  =  SHM  *  RM1NF(I)*DMU 

CHP  =  CHP  *  RP I NF ( I ) *FMU ( 1 ) »DMU 

670  CHM  =  CHM  f  RMINF ( I ) *FMU( I ) ‘DMU 

DPINF  =  ShP/CHP 
OMINF  =  SHM/CHM 
K( INFINITY)  6V  76/ 19 . 2 
FKINF  =  ALPHA»£iGVl 1 ) 

R(INFINITV)  by  76/19.5 
absorb  =  alpha  -  TOTALS! 1) 

RINF  =  (FKINF  -  A6S0R6*DMI  NF  )  /  (  I- K  1  NF  ^  A8  SORB  •  DP  I  NF  ) 
call  EPSI NF ( RPI NF . RMI NF .  EPSP.EPSM) 

WRITE(6.672)  OPINF, DM  INF. RINF, EPSP.EPSM 

ENDIF 

RETURN 

formats 

301  FORMAT!//'  THE  IOMPLEX  EIGENVAI.UES  OF  K  ARE  '  /  /  !  1  P2  E  25  .  1 5  )  ) 

304  FORMAT!//'  THE  PERFORMANCE  INDEX  IS',E15.5) 

655  FORMAT! //■  THE  SHAPE  OF  THE  ASYMPTOTIC  RADIANCE  DISTRIBUTION  IS  GI 
IVEN  BY'//'  I  RADINF!-)  RAOINFI*)’/) 

657  FORMATIIH  .  I  4 ,  1 P 2 E 1 5 . 4 ) 

672  FORMAT!//'  OTHER  ASYMPTOTIC  VALUES  ARE'//  D*!InFINITY) 

1  F7.4/  D-(INFINITY)  =',F7.4/'  R'(INFINITY)  =',1PE11.4/ 

2'  £PS*(INFINITV)  =' ,0PF8 .5/'  EPS-!INFINITV)  =',F8.5) 

680  FORMAT!//'  THE  ORDERED  POSITIVE  EIGENVALUES  OF  K!l=  .12. 

1)  ARE'//'  NONDIMEN  PER  METER ' / / ! 1 P2E 1 5 . 6 ) ) 

681  FORMAT!/'  J  1P'//!2I5); 

END 
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^  subroutine  EPSI NF ( RPINP , RMINF .  EPSP.EPSM) 

C  ON  NHM4/ePSINF 

C 

C  THIS  routine  computes  The  asymptotic  backscatter  eccentricities 

C  EPSILON6(+)  AND  EPSILONB(-)  USING  (8.15A)  AND  THE  NORMALIZED 

C  ASYMPTOTIC  RADIANCE  DISTRIBUTION 

C 

PARAMETER (MXMU= 10 ,  MXPHI=24.  MXY=30 .  MXSIGy=3) 

PARAMETER!  MXL=MX  PM  1/2.  MXGEOP=MXMU  »  (  MXL  1  )  ) 

C 

DIMENSION  RPINF'MXMUJ .RMINF(MXMU) 

C 

COMMON/ CGR ID/  FMU ( MXMU)  , PHI (MX PH  I )  . V ( MXV )  , BNDMU(MXMU )  . 

1  BNDPHI (MXPHI ), OMEGA (MXMU ). DELTMu (MXMU ), ZGEO C MXV ) 

COMMON/CRTSIG/  RhOHAT(MXMU . MXMU .MxSIGv )  . TAUHAT (MXMU , MXMU , MXS I  GY ) 
1  GEOPP ( MXMU . MXGEOP , MXSIGV ). GEOPM( MXMU , MXGEOP  MXSIGV) 

COMMON /CM I  SC/  IMISC(20)  .FMISC(20) 

C 

NMU  =  IMISC(l) 

NPHI  =  IMISC(2) 

NSIGV  =  IMISC(5) 

NOPI  =  NPHI/2 
TWOPI  =  2 . O’FMI SC ( 1 ) 

L 

SHPINF  =  0. 

SHMINF  =  0 
EPSP  -  Q. 

EPSM  =  0 , 

C 

DO  100  IU=1,NM0 
C 

C  ACCUMULATE  scalar  IRRADIAN^.E  SuMb 

SHPINF  =  SHPINF  »  RPINF(  1  U  )  »DEi- TMul  1  U  I 
ShMINF  =  SHMIN‘  »  RMINF ( I u ) •OElTMu,  1 .1 ) 

C 

QUV  -  OMEGA(IU, 

IVMAX  -■  NPHI 
I  F  (  I'J  .  EO  .  NMU  )  ;  .  MAX  =  1 

DO  100  I V= 1 . ! VMA* 

C 

OU  lOU  1R=1,NMU 
RP  =  RPINF(IRJ 
RM  -  RMINF( IN ) 

ISMAX  =  fJPHi 
I F ( I R . EO . NMU )  I SMAa  -  i 
DO  100  I S= 1 . I bMAX 

T  COMPUTE  The  storage  INDEX  FOR  P "  ( R .  ij  ,  /  )  BY  12.7 

I  V  S  =  I  A  B  S  (  1  V  1  s  ) 

IF(IR.EG.NML; 

FCOl  -  lU 

else 

I  F  1  1 U  .  E  L  NMU )  Then 

FCOl  NMij 
ELSE 

IF  i  /S  .  L.  E  .  NOP  I  )  Then 
KM.  -  lU  ■>  NMu’lvS 
E  !.  S  r 

KCO.  -  lU  ♦  NMU*(NUPi  MoCH  I  VS . NUPI  )  j 
E  N  D  i  F 

ENDI  F 

ENUI  F 

L 

PM  -  GEOPM  (  1  R  .  x LOi_  ,  NS  1  Gv  ) 

L 

EPSP  =  EPSP  »  0UV*RP*PM 
100  EPSM  =  EPSM  ->  Quv»RM*PM 
r 

EPSP  =  EPSP/ (  FVVOPI  ♦  SHPI  NF  I 
EPSM  =  EPSM/ (  TwOPI *SHMINF  ) 

C 

RETURN 

END 
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FUNCTION  FALPHA(Y) 

ON  NHM4/FALPHA 

GIVEN  AN  optical  DEPTH  V.  THIS  FUNCTION  RETURNS  THE  VALUE  CF 
1  .Q/ALPHA(y )  .  WHERE  ALPHA  IS  THE  ATTENUATION  COEFFICIENT.  FOR 
USE  IN  integrating  DV/ALPHA(V)  TO  GET  GEOMETRIC  DEPTHS  (SEE 
subroutine  V2ZGEO) . 

PARAMETER (MXS I GV= 3) 

C 

COMMON/C SIGY/  YSIG(MXSIGY)  . ALBE SS ( MXS £ G V )  , TOTALS ( MX S I  GY ) 
COMMON/CMI SC/  IMISC(20) 

C 

NSIGY  =  IMISC(5) 

c 

I F (NSIGY . EQ .  I  .OR.  Y . LE . Y S I G (  1 )  )  THEN 
C 

ALPHAl  =  TOTAlS( 1 ) /ALBESS( 1 ) 

C 

ELSEIF(Y.GT. YSIG(NSIGY))  THEN 
C 

ALPHAl  =  TOTALS(NSIGY)/ALBESS(NSiGY) 

C 

ELSE 

C 

DO  55  JY=2,NSIGv 
IF(Y.LT.YSIG(jY)|  GO  TO  56 

55  CONTINUE 

56  OY  =  (Y  -  YSIG( jv-1)  )/(YSlGl  JYj  -  YSIu(JY-l)) 

ALPHAl  =  (1.0  -  OV ) •TOTALS! JY -  1 ) /ALBESS( jy- 1  )  + 

1  DY»T0TALS( JY)/ALBESS( JY) 

C 

ENDI  F 

C 

FALPHA  =  ALPHAl 

RETURN 

END 


SUBROUT  I NE  FFMPAK{X,Y,Z.I ROW , NMU . L . WORK ) 

C 

C  ON  NHM4/FFMPAK 

C 

c  This  routine  furms  the  matrix  product  x  •  y  =  z.  where  k,  y,  and  z 

C  ARE  BLOCK  MATRICES  STORED  ON  ThE  PACKED  FORMAT  OF  12.4. 

C 

C  indexing  is  somewhat  complicated,  doe  to  the  packing  FORMAT. 

C  THE  VARIOUS  INDICES  USED  ARE 

C 


C 

I  XB  .  . 

.BLOCK  pow  index  of  X 

r 

11... 

.element  row  offset  of 

Block  row 

IXB 

OF  X 

C 

J  1  .  .  . 

.element  column  offset 

QF 

block 

COLUMN  KX  OF  X 

C 

JYB  .  . 

Block  cc'lumn  index  of 

V 

C 

12... 

.element  row  offset  of 

block  row 

KY 

OF  Y 

C 

J2  .  .  . 

.element  column  offset 

GF 

block 

JY8 

OF  V 

C 

KX  .  .  . 

.Block  column  index  of 

X 

C 

KY  .  .  . 

.Block  row  index  of  y 

c  I . j . K . Element  indices  within  an  nmu  by  nmu  block 

c 

C  WORK  MUST  have  at  LEmST  nmu»nmu  words 

DIMENSION  X {  I  ROW.  1 )  . Y{ IROW .  1)  . Z (  IROw ,  1  )  . WORK ( NMU ,  1  ) 
C 
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LPl  =  L  »  1 

00  100  1X0=1, LPl 

11  =  (IXB-1)*NMU 
JX82  =  L/2  +  1 

I F (M0D( 1X0 , 2 ) . EQ . 0 )  JX02  =  (Ltl)/2 
C 

DO  xOO  JY0  =  1,JXB2 
J2  =  (JV0-1)*NMU 
C 

c  ZERO  The  accumulation  block 
DO  110  1=1, NMU 
DO  no  J=1,NMU 
1 10  WORK ( I , J )  =  0 . 

MULTIPLY  block  ROW  IXB  OF  X  BY  BLOCK  COLUMN  JVB  OF  V 

DO  300  KX=1,JXB2 
KV  =  2*KX  -  1 

IF(MOD( IXB, 2) . EQ.O)  KV  =  2»KX 
Jl  =  ( KX  -  1)*NMU 

12  =  (KV  -  1)*NMU 

MULTIPLY  Block  (IXB,KX)  OF  X  BY  BlOlx  (KV,JVB)  OF  Y 
DO  300  1=1, NMU 
DO  300  J=1,NMU 
SUM  =  0. 

DO  301  K= 1 , NMU 

301  SUM  =  SUM  +  X  (  I  If  I  ,  J  l  +  K) ’YC  I  2*x  ,  jZ-- J  ) 

300  W0RK(I,J)  =  W0RK(I,J)  f  SOM 

STORE  The  block  in  THE  PACKED  I  ARRAY  AS  BLOCK  (IXB,JY8) 

DO  400  1=1, NMU 
DO  400  J=1,NMU 
400  Z(llfl,j2fj)  =  WORK(i,J) 

100  continue 

RE  TURN 
END 


FUNCTION  PHASEF  ( V , COSPSI  ) 

C 

C  ON  NHM4/PFuIMUE 

C 

C  This  FuNCTr'^fj  returns  the  vauue  of  the  phase  function  as  defined 

C  for  lake  LlM-iE.  (SEE  radiative  'RANSFER  in  natural  waters,  chapter  5, 

C  table  5.3,  wt-rN  published.  MEANWHILE.  RECjARD  THIS  PhAsE  FUNCTION 

C  AS  typical  of  moderately  TURBID  LAKE  WATER.) 

C 

C  SINCE  The  phase  FUNCTION  IS 

r.  NEARl.V  linear  ON  A  lOG-lOG  ploi.  linear  interpolation  is 

C  PERFORMED  IN  L OG ^ PHA SE  ) - LOG  I  PS  I  )  . 

c 

PARAME TER ( MXF rs=22 .  MXSIGV=J) 

c 

DIMENSION  SIGMA(MXPTS)  .PSI  (M»PTS)  , PLOGl MXPTS )  , P S I  LOG ( MX  f  T  s ) 

COMMON /CS I  GY /  VS1G(MXSIGY),AlBcSS|MXSIGV),TOTALS(MXSIGY) 

COMMON /CM I Sr/  IMISC(20).FMISC(20) 

C 
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DATA  PSI /O . 0 , 0 . 01 , 0 . 1 , I . 0 . 

1  10  .  ,  20  .  ,  30 .  , 40 .  , 50 .  .60 .  . 70 .  ,00 .  .90 .  .  100 .  ,  1 10 .  ,  120  .  ,  130  .  . 

2  140.  ,  150.  ,  160.  ,  170.  ,  100.  / 

DATA  SIGMA/ 7 . 9  4DQ9E6 .  /  . 9  2609E6, 3  1554  3 .  ,  12562.  .315.55,90.62, 

1  30.09,13.2.6.41.3.47.2.08.1.37.1.0.0.811.0.716,0.691, 

2  0.693.0.707,0.741,0. 766 .0.782.0. 789/ 

DATA  HALL/0/,  NSIGV/l/,  S.ALPHA/O.S.  0.8/ 

data  SIG90/0 . 002 1401 / .  PSIO/O.Ol/,  APS  I / 4 3 . 4  19 7 / ,  PPSI/1.4/ 

C 

I  F  (KALL  .  EQ  .  0  )  THE.M 

THE  FIRST  CALL  IS  USED  FOR  INITIALIZATION 

PI  =  FMISUl) 
degrad  =  FMISC(2) 

RADEG  -  FM1SC(3) 

IMISC(5)  =  NSIGV 
vsiG( n  =  0 . 
totals (  1  )  =  S 
ALBESS(I)  =  S/AlPhA 

CONVERT  TABULATED  VALUES  TO  LOGS 
SI  =  SIG9Q/S 
DO  100  I=2,MXPTS 
PLOG(I)  =  ALOGIuI S1*SIGMA( I ) ) 

100  PSiLOGd)  =  ALOGIOCPSI  (  I  )  ) 

PlOG( 1 )  =  PLOGI 2 ) 

PSILOG(l)  =  -1.DE200 

WRITE(6,200) 

WRIT£(6,202)  AlPhA.S 
WRITE(6,204) 

00  102  dl.MXPIS 
PHASE  =  10 . 0* ♦PL0G( I  ) 

102  WRITE(6,206)  P S I ( I  1 , S 1 GMA ( I )  . Pha SE 
WRIT£(6.207)  SIG90 
WRITE16.208) 

GET  The  ANALVTJl  integral  from  PSI  -  0  10  PSI  =  PSIO 

APSI  -  APSI*Slu9U/S 
SOPSIO  -  2 . 0*PI ‘APSI / ( 2 . 0  -  PPi!) 

SOPSIO  =  SOPSIO*  (  PSI0*DEGRAD  )“(  2  .  U  -  PPSI) 

WRITE(6,210)  PSIO. SOPSIO. APSI, PPSI 

KALL  =  1 
PHASE L  =  U. 

ELSE 

convert  cos(psi)  to  log(psi)  and  interpolate 

IF(ABSlCOSPSI ) .GT . 1 .0)  THEN 
COSPSI  =  SIGN! 1 .O.COSPSI ) 

ENDIF 

PSIOEG  =  RADE(j*ACOS(  COSPSI  ) 

I F ( PSIDEG . LT .  1  . OE - 8 )  THEN 
PS  I L  =  -8.0 

ELSE  I F ( PSI DEG  GT .  180 .  )  THEN 
PSI L  =  ALOGIuI  18u .  1 
ELSE 

PSIi.  =  ALOG:  L  ,  --SI  DEG) 

ENDIF 

I  F  (  PSI  L  .  LE  .  PS  ;  .-0G(  2  )  )  Then 
PmASEu  - 
E  L.  St 

LjO  30U  I  ~ 

r  F  (  PS  1 1  .  L  T  ,  I  i.ou(  I  ;  ►  cio  to  i-jj 
JOU  '..ONTir-iuE 

31J  2  PHfl  -gE  l  ■  Pl  Oim  1  -  1  )  I  PL  (  I  ’  -  ^’L  IG  (  I  MI* 

1  iPSlu  PSl^uG.'I  1  )  )  /  (  f'SI  i-UL.(  1  )  -  -•  J  1  lGGI  I  -  1  )  ) 

END  I  f 

END  I  F 
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PMASEF  =  !0.0»*PhAS£l 

KAll  =  KALL  1 
RETURN 

C 

200  format(ihi.'  the  volume  scattering  function  fok  lake  limne  is  used 

1  AT  ALL  depths • ) 

202  F0RMAT(1h0,’  The  volume  ATTENUATION  COEFFICIENT  ALPHA  IS'. 

1F6.3,'  PER  METER'//'  THE  TOTAL  VOLUME  SCATTERING  FUNCTION  S  IS', 
2F6. 3 .  PER  METER ' ) 

204  FORMATIIHG,'  the  TABULATED  VALUES  DEFINING  SIGMA(PSI)  ARE'// 

1'  PSI  SIGMA/SIG90 '  .9X Phase '/ ) 

206  FORMATCIH  . F7 , 2 . F 15 . 3 , F 10 . 6) 

207  FORMATIIhQ.'  SIGMA(90)  =  .1PE13.D) 

200  F0RMAT(1HQ.'  linear  interpolation  is  done  in  LOGIPSI )-L0G(PHASE) ' ) 
210  FORMATflHO.'  THE  ANALYTIC  INTEGRAL  OF  2 • P I • PHA SE ( PS  I  ) * S I N ( PS  I )  '  / / 
1'  FROM  PSI  =  0  TO  PS:  ='.F5.3.'  I S '  .  1 PE  1 4 . 6 ,  '  FOR  A  =',E14.6 

2  AND  P  = ' . 0PF5 . 2 ) 

END 


FuN(!TION  PmASE“(V.COSPS!I 
C 

C  ON  NHM4/PFPElA'j 

c 

c  THIS  FUNCTION  returns  ThE  vAluE  OF  THE  PHASE  FUNCTION  AS  DEFINED 

C  FOR  The  PELAGO'S  sea.  (SEE  RADIATIvE  TRANSFER  IN  NATURAL  WATERS, 

C  chapter  5,  table  5.5,  WHEN  PuBuISnEO.  MEANwhIlE.  REGARD  THIS 

c  SCATTERING  Function  as  typical  lF  clean,  open  ocean  waters.) 

c 

C  GIVEN  the  WAlElEN.jTh  in  nanometers,  wavenm.  the  first  call  to 

C  the  ROUllNE  linearly  I  NT  E  R  I'Ul  A  T  £  s  I  T(  lOG(NORM  SIGMA)  TO  GET  A  NORMALIZED 

c  sigma  Function  for  the  desired  wavelength  at  each  tabulated  scattering 

C  ANGLE,  PSI.  'A^uEs  OF  The  ABSORBUON  AND  TOTAL  SCATTERING  ARE 

c  also  determined  for  The  reolcsted  wavelength. 

r 

C  N.B. :  The  RECuESTED  WAVElENGTH,  wAvENM,  SHOULD  BE  ONE  OF  THE 

C  DISCRETE  NHM  wAvElEnGThS  (NAMEly.  400..  425  .  675.  OR  700,  NM )  . 

C  this  IS  BECAUSE  ThE  SIGMA(9U)  VAluES  CANNOT  BE  OBTAINED  BY 

C  I  NTERPOL  A  T  I  UN  OF  The  TABUlATEu  vAlviEs. 

c 

C  SINCE  The  Phase  FijnC’^ION  is  nearly  LINEAR  ON  A  LOG-lOG  PlOT  , 

C  LINEAR  INTERT'ClA  riON  IS  PERFORMED  IN  lOG  (  PHA  SE  )  -  LOG  (  PS  I  )  IN  ORDER 

C  TO  define  vAluEs  OF  THE  PmAsE  F.iNC.TIUN  AT  ARBITRARY  PSI  VALUES. 

C 

DARAMETER(MYpT-,i./v,  MxSIuv-J) 

C 

DIMENSION  SIGN  A  ^  MXPT  i  )  .PCI  (  MxP''  i  )  ,  PI  OGl  MXPT  S  )  ,  P  S  I  L  UG  t  M  X  PT  S  ) 

DIMENSION  S4j  ‘  :  MxPTS)  ,  S700(MxPT  y  .  SIGlCGI  MXPTS  ) 

DIMENSION  wv^ 'AB(  IS )  .ABSORB!  IJ  J  , TSCAT  (  13)  , S90(  13) 

CGMMON/CS  I  Gv  -  V  s  I  G  !  M.xSI'GV  )  .  A  ^  BE  3  s  <  MX  S  I  G  Y  ;  ,  TOT  A  l  S  (  MX  S  I  G  Y  ) 

COMM'jN/  CMI  Sl  ,  ;  M  I  sl  :  20  )  .  FMI  sC  i  V  ^  I 

f 

DATA  PSI/lj.C,  '  ,  u  1  ,  0  .  1  ,  1  .  C  . 

1  1C  20  .  ,  .3U  .  ,  4  j  ,  ,  50  .  .  6u  .  ,  7u  .  ,  fau  .  ,  Uu  .  .  lOU  .  ,  1  10  .  ,  1  20  .  ,  1  30  .  , 

2  140  .  ,  15(j  .  ,  U'L  .  .  1  70  .  ,  100  .  / 

DATA  S4a(J/  0,'4o0U.,  874609..  .J4av2..  1386  29,  34.022,  10.,  5.. 


1 

2.8,  2.0,  I 

0 .  1.25.  1.1. 

1.0,  . Jb , 

. 98 ,  1.05, 

1.22, 

1 . 5 

2 

1.9.  2.25, 

2  55 .  2.7/ 

DATA  S700/  3. 

9JblE6,  3.9361 

Eb ,  1 bb  7uO . 

,  6238.3, 

156 . 7 . 

45  . 

1 

2U  .  ,  9  .  .  4  . 

1 ,  2,65.  1.72. 

1.22.  1 . 0 . 

.  94 ,  . 94 , 

1.0, 

1.12 

2 

1.33,  1.6. 

1  8 ,  1.9,  2.0/ 

C 
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data  WVLTAB/400  ,  425.,  460..  476..  500..  525..  550.,  575., 

1  600.,  625.,  650.,  675,.  700./ 

DATA  absorb/  .06,  .05.  .05.  .05.  .05.  .06,  .08,  .14.  .25,  .30, 

1  .37,  .43.  .60/ 

DATA  TSCAT/  .04.  .0325,  .0275.  .0234,  .02,  ,0175.  .0152,  .0136, 

1  .0122,  .0115,  .0108.  .0102.  .01/ 

DATA  S90/9 . 98348E-4 ,  7 . 45989E-4 .  5.7a771E-4,  4.50275E-4. 

1  3.50922E-4,  2.79280E-4,  2.201076E-4.  1.78304E-4,  1.44517E-4. 

2  1. 228486-4,  1.038586-4,  8.815764E-5.  7,756346-5/ 

C 

DATA  KALL/0.'  ,  NSIGV/l/ 

DATA  APSI400,APSI700/4. 791616.  21.562268/,  PSIO/O.Dl/,  PPSI/1.4/ 
C 

IF( KALL . EQ. O)  THEN 

THE  HIRST  CALL  IS  USED  FOR  INITIALIZATION 

PI  =  FMISC(  1) 

DEGRAD  =  FMISCiZ) 

RADEG  =  FMISC(J) 

WAVENM  =  FMI SC( 13) 

IMISC(5)  =  NSIGv 

LINEARLY  interpolate  IN  LOG ( NORMAL  I  ZED  S I GMA ) -WA VE LE NG TH  TO 
define  A  NORMALIZED  SIGMA  AT  THE  REQUESTED  WAVELENGTH.  AT  EACH 
TABULATED  PSI  VALUE 

IF (WAVENM. LE . 400 . )  THEN 
WAVEF  =  0. 

else: F ; wA vENM . Gt . /UU . )  iHtN 
WAvEF  =  1 . 

ELSE 

WAVEF  =  (WAVENM  -  400.)/300. 

ENOI  F 
C 

DO  400  l=l,MXPTS 

SIGLOG(I)  =  (1.0  -  WAVEF)*AL0G10(S400(  1  )  ) 

1  WAVEF*AL0G10( S700 ( I ) ) 

400  SIGMA(l)  =  10 . 0*»SIGlOG( I ) 

C 

C  LOOK  UP  THE  ABSORBTION.  TOTAL  SCATTERING,  AND  SIGMA(9D)  VALUES 

C  FOR  THE  requested  WAvElENGTh 

L 

IWAVE  =  IF1X(1.5  »  AMOO(WAVENM . 4u0 .  ) / 25 .  ) 

A8SR  =  ABSORBf IWAVE ! 

S  =  TSCAT(IWAVE) 

SIG90  =  S90(IWAVE) 

ALPHA  =  ABSR  »  S 
C 

VSIG( 1 )  =  0 . 

TOTALS! 1)  =  S 
ALBESS( 1 )  =  S/ alpha 
C 

C  CONVERT  THE  defined  SIGMA  TO  LOub  OF  THE  PHASE  FUNCTION 

SI  =  SIGB^'/S 
DO  100  I  =  2,MXP''S 

PLOG(I)  =  AlOG  10( S1*SIGMA ( I ) ) 

100  PSIlOGII)  =  AlOG10( PSI ( I ) ) 

PLOG(l)  =  PlOG(2) 

PSILOGI  1 )  =  -  1 . 0E2U0 
C 

WR I TE ( 6 , 200  ) 

WRITE! 6 , 202 )  wA  vENM , ABSR . S . AlPHA  .  Ai  eESS(  1  ) 

WRITE(6,204) 

DO  102  I=2.MxPTS 

Phase  =  lo . C‘ *plog( i ) 

102  WR1T£(6,206)  PS I ( I ) , S I GMA ( I ) . PhA SE 
wRITE{6,207)  SIG90 
WR I TE I  6 . 208  ) 
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GET  THE  ANALVTJC  iNTEGRAL  FROM  Hi/  -  O  TO  Pbl  =  PSiO 

APSI  =  WAVEF»AL0G10CAPS1  700) 

APSI  =  APSI*SIG90/S 

SOPSIO  =  2 . 0»PI *APSI / ( 2 . 0  -  PPSI) 

SOPSIO  =  SOPSIQ»CPSIO‘DEGRAO)»»(2  u  -  PPSI) 

WRITE (6. 210)  PS  10. SOPS  10. APS  I  .PPSI 

kall  =  1 
PHASEL  =  0. 

ELSE 

CONVERT  COSCPSI)  TO  LOGCPSI)  AND  INTERPOLATE 

IF{ABS(C0SPSI ) .GT . 1 .0)  then 
COSPSI  =  SIGN( I . 0 . COSPSI ) 

ENDl  F 

PSIOEG  =  RAOEG*ACOS(COSPSI  ) 

I F ( PSIDEG . LT  .  1  .  QE-B  )  THEN 
PSIL  =  -a.o 

ELSEIF ( PSIOEG . GT  .  180 .  )  THEN 
PSIL  =  ALOG10(  180  .  ) 

ELSE 

PSIl  ^  ALOOIC;' wiDcC' 

ENDIF 

IF(psil.le.psIl0G(2)  )  then 
PHASEL  =  Pl0G(2) 

else 

00  300  I=2.MXPTS 
IF(PSIL . LT. PSILOGI I  )  )  GO  TO  302 
300  CONTINUE 

302  phased  =  PLOG(I-l)  +  (PLOG(I)  -  PLOGlI-i))* 

1  (PSIl  '  PSILOG(  I-n  )/{PSIlOG(  1  )  -  PSILOGd'D) 

ENOIF 

ENDIF 

PHASEF  =  10.0**PhaSEl 
kall  =  KAlL  »  1 
RETURN 

200  FORMAT  I  IHl,'  THE  vOluMNE  SCATTERING  FUNCTION  DEFINED  FOR  THE  PELAG 
lOS  SEA  IS  USED  AT  ALL  DEPTHS) 

202  FORMAT! IHO,'  The  WAVELENGTH  IS  LAMBDA  ='.F6.1.'  NANOMETERS'// 

1'  The  volume  ABSORBTION  rUNLTION  IS  A  =',F7.A.'  PER  ME'^ER'// 

2'  THE  total  volume  SCATTERING  FUNCTION  IS  S  ='.F7.4.'  PER  METER'/ 
3/'  THE  VOLUME  ATTENUATION  FuNC.TIOn  IS  ALPHA  ='.F7.4.'  PER  METER'/ 
4/'  THE  ALBEDO  OF  SINGLE  SCATTERING  IS  OMEGA  =',F7.4) 

204  FORMAT! IHU.'  THE  TABULATED  VALUES  DEFINING  SIGMA(PSI)  ARE'// 

1'  PSI  S I GMA/ SIG90  '  . 9K .  • Phase  '  /  ) 

206  FURMAT(1h  . F 7 . 2 . F 15 . 3 . F 18 . 6 ) 

207  F0RMAT{1H0.'  SIGMA(90)  -'.1PE;3.6) 

208  FORMAT(1hO,'  linear  INTERPOLATION  IS  DONE  IN  LOG ( P S I ) - lOG ( PH A SE ) ' ) 
210  F0RMAT(1h0.'  The  ANALYTIC  INTEGRAL  OF  2 » P I  * PHA SE ( PS  I  ) • S 1 N ( P S I  )  '  / / 

1'  FROM  PSI  -  0  TO  PSI  =^'.F5,3.'  1  S  '  .  1  PE  1 4 . 6 .  '  FOR  A  -'.E14.6. 

2 '  AND  P  = '  . 0PF5 , 2  ) 

END 
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FUNCTION  PHASEF ( V , COSPSI ) 

ON  NHM4/PFSPHER 

THIS  FUNCTION  RETURNS  A  VALUE  OF  THE  CONTINUOUS.  POINT  GEOMETRIC 
PHASE  FUNCTION  P(Y,  MU  PRIME,  PHI  PRIME/  MU,  PHI)  =  P(COSPSI,Y)  = 
SIGMAICOSPSI ,Y)/S(Y)  FOR  ANY  COS(PSI)  AND  V  VALUES. 

PHASEF  IS  FOR  USE  IN  THE  COMPUTATION  CF  THE  QUAD- AVERAGED . 

GEOMETRIC  SCATTERING  FUNCTIONS  P(Y.  R.S/  U.V)  =  P(Y.  R/  U.V")  VIA 
11.3. 

THIS  VERSION  FOR  FOR  ISOTROPIC  SCATTERING;  SIGMA  =  S/(4»PI) 
independent  OF  SCATTERING  ANGLE  AND  DEPTH 

parameter (MAS  I  GY  =  3) 

COMMON/ CS I  GY/  YSIG(MXSIGY)  .AlBESSIMXSIGY)  .TOTALS! MX SIGV) 

COMMON/ CM I  SC/  I  Ml  SC (20) .FMISC(20) 

DATA  KALL/0/,  nSIGY/1/,  S . AlPHA / 0 . 1 25 .  0.736/ 

I F (KALL . EQ . 0)  then 

The  FIRST  CAuL  TO  PHASEF  IS  USED  FOR  INITIALIZATION  ONLY 

PI  =  FMI SC (  1  ) 

SIG  =  0 . 25»S/PI 
IMISC(5)  =  NSIGV 
VSIG(  1  )  =  0. 

TOTAlS(I)  -  S 
AL0£SS(  1 )  =  S/alpha 
WRITEC6. 100)  SIG 
WR1TE(6,102)  ALPHA, S 
SIG  =  0 . 25/PI 
KALL  =  1 
PHASEF  =  0. 

RETURN 

ELSE 

PHASEF  =  SIG 
RETURN 
ENOIF 

100  FORMAT!  IHl,'  A  SPHERICALLY  SYMMETRIC  VOLUME  SCATTERING  FUNCTION  IS 
1  USED: ■ 

2//'  SIGMA  =  S/(4*PI)  ='.F0.5.’  FOR  ALL  ANGLES  ANO  DEPTHS') 

102  FORMAT (  IHO ,' the  VOLUME  ATTENUATION  COEFFICIENT  ALPHA  IS  ,F6.3, 

1'  PER  METER'//'  THE  TOTAL  VOLUME  SCATTERING  FUNCTION  S  IS', 

2F6 . 3 . '  PER  METER ' ) 

END 


C 

C 

C 

C 

C 

C 

c 

c 

c 

c 

c 

c 

c 


c 
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FUNCTION  PHASEF ( V , COSPSI ) 

ON  NHM4/PF5PV 

THIS  FUNCTION  RETURNS  A  VALUE  OF  THE  CONTINUOUS.  POINT  GEOMETRIC 
phase  function  P(V.  mu  prime,  phi  prime/  mu.  PHI)  =  P(V. COSPSI)  = 
SIGMA(V.COSPSI)/S(Y)  FOR  ANV  Y  AND  COS(PSl)  VALUES. 

PHASEF  IS  FOR  USE  IN  THE  COMPUTATION  OF  THE  QUAD- AVERAGED . 
GEOMETRIC  SCATTERING  FUNCTIONS  P(Y,  R.S/  U.V)  =  P(Y.  R/  U.V")  VIA 
(11.3) 

THIS  VERSION  IS  FOR  DEPTH  DEPENDENT  SPHERICAL  SCATTERING; 

SIGMA(Y)  =  S(Y)/(4*PI).  INDEPENDENT  OF  SCATTERING  ANGLE 
BUT  DEPENDENT  ON  DEPTH  Y. 

PARAMETER ( MX SIGY=3) 

DIMENSION  ALPHA (MXSI GY ) 

COMMON/CS IGY/  YSIG(MXSIGV).AiBESS(MXSIGY).TOTALS{MXSIGY) 

COMMON/ CMI SC/  IMl SC ( 20) . FMI SC ( 20) 

DATA  KAlL/0/  .  NSIGY/3/ 

DATA  YSIG/ 1 . . 5 . . 10 . / .  TOT A L S / 0 . 1 . 0 . OS . 0 . 3 / .  ALPHA / 0 . 2 . 0 . 6 . 0 . 4 / 

C 

if(kall . EQ. 0)  Then 
C 

C  The  first  call  to  PHASEF  is  used  for  initialization  only 

c 

PI  =  FMI 5C( 1 ) 

IMISCCS)  -  NSIGV 
WRITE! 6, 100) 

DO  50  I Y= 1 , NSIGV 

ALeESS(IY)  =  TOTAuS!  I Y) /ALPHA  I  1 V ) 

50  WRITEC6.102)  I  V . v ^ 1 0 ( I Y ) . TO^ AL S ( I Y )  . AL PhA ( I  V )  . ALBE S S ( I Y ) 

P  =  0 . 25/PI 
KALL  =  1 
PHASEF  =  0. 

C 

ELSE 

PHASEF  =  P 
ENOI  F 
RETURN 
C 

100  FORMAT)///'  A  DEPTH  DEPENDENT.  SPHERICAL  VO( UME  SCATTERING  FUNCTIO 
IN  IS  USED;'//  SIGMA(Y.C0S(PSI ; )  =  S(v)/(4*PI)  WHERE// 

2'  lY  V  S(Y)  ALPHA(Y)  S/AIPhA  /) 

102  F0RMAT(1H  ,  I  4 , F8  .  1  . F8 . 3 . F  10 . 3 . F  1 1  . u ) 

END 
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subroutine  PNTAMP( V , AMPA , AMPY . IROw) 

ON  NHM4/PNTAMP 

THIS  routine  prints  THE  AMPLITUDES  AT  V  =  A .  X .  Z. 

A  title  giving  the  APPROPRIATE  COLUMN  HEADINGS  SHOULD  BE  WRITTEN 
BEFORE  CALLING  PNTAMP . 

IF  ONLY  AMPA  IS  TO  BE  PRINTED  (THE  CASE  OF  AMPA  =  AO ( A . + ) ) .  GIVE 
AMPY(l.l)  A  value  .GT.  1.0E200 

DIMENSION  Y(  1)  ,AMPA(  1)  .AMPY (I  ROW,  1) 

COMMON/CMISC/  IMISC(20) 

NMU  =  IMISC(l) 

NY  =  IMISC(A) 

IDBUG  ^  IMISCO) 

NRHAT  =  IMISC(IO) 

IL  =  0 

lAOP  =  1  IF  printout  is  FOR  AMPA  ONLY 
lAQP  =  0  OTHERWISE 
lAOP  =  0 

I F ( AMPY( 1 . 1 ) . GT . 1 . E200)  lAQP  =  1 
IF( lAOP. £Q. 1 )  WRITE(6, 1599) 

IF( lAOP. EQ. 0)  WRITE(6, 1600)  ( Y ( I Y ) . I Y= 1 , NY ) 

DO  1602  I=1.2»NHHAT 

IF(I .eo.nrhat+1)  then 
WRITE(6. 1610) 

IL  =  0 
ENDIF 

IMOD  =  M0D( I .NMU) 

IF( IMOD.EQ. 1)  THEN 
WRITE(6. 1606)  IL 
IL  =  IL  +  1 
IMU  =  0 
ENDIF 

IMU  =  IMU  ♦  1 

SELECT  FULL  OR  PARTIAL  PRINTOUT 

IF( IDBUG. EQ. 1  .AND.  IL.GT.2)  GO  10  16U2 

IF(IAOP.EQ.O)  THEN 

IF( IMOD.EQ.  1)  WR I TE(6 . 1612 )  I  MU . AMPA (  1  )  . ( AMP Y ( 1  , J )  , J= 1 . N V ) 

IF ( IMOD . NE . 1 )  WRITE(6. 1614)  IMu . AMPA ( I ) . ( AMP Y ( I , J ) , J = 1 , NY ) 
else 

IF ( IMOO . EQ . 1 )  WRITE(6. 1612)  IMU.AMPA(i) 

I F( IMOD . NE . 1 )  WRITE(6, 1614)  IMU.AMPA(l) 

ENDIF 

1602  CONTINUE 
RETURN 

FORMATS 

1599  FORMAT! 1H0,2X. 'COSINES' ) 

1600  FORMAT ( IHO , 2X .' COSINES '. 23X.5( • Y  = ' . F / . 3 , bx j / 33X , 5 ( ' Y  =',F7.3,5X)) 
1606  FORMATdhO,'  L  =',I3) 

1610  FORMAT! IHO . 2X .' SINES ' ) 

1612  FORMAT!  IH* ,  lOx ,  I  2 ,  1P6E  15 . 4/ 28x . bE 15 . 4 ) 

1614  F0RMAT!1H  ,  lOX ,  I  2 ,  1P6E 15 . 4/ 28X , 5E 15 . 4 ) 

END 
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SUBROUTINE  QAPHAS(NUQB.NVQB. INCBAS) 

C 

C  ON  NMM4/QAPHAS 

C 

C  THIS  routine  computes  the  quao-averaoed  geometric  phase 

C  FUNCTIONS  GEOPP  =  P+CY;R,U.V)  AND  GEOPM  =  P-(V:R.U,V)  USING  11.3. 

C  values  are  computed  at  each  V  level  where  the  POINT  GEOMETRIC 

C  PHASE  FUNCTION  IS  GIVEN  (BV  FUNCTION  PHASEF) 

C 

C  NUQB  and  NVQB  are  the  base  number  of  quad  SUBDIVISIONS  IN  THE  MU  AND  PHI 

C  DIRECTIONS.  USED  FOR  NUMERICAL  INTEGRATION  OF  THE  CONTINUOUS 

C  phase  FUNCTION,  THE  NUMBER  OF  QUAD  SUBDIVISIONS  IS  INCREASED 

C  BV  A  FACTOR  OF  INCBAS  IN  THE  FORWARD  SCATTERING  QUADS  AND  IN 

C  THE  ADJACENT  QUADS. 

C 

C  THE  ARRAY  PHASE! I, IV)  CONTAINS  THE  TABULATED  VALUES  OF 

C  PHASEF( Y( I  V)  ,COS(PSI ( I  ) ) 

C 

PARAMETER(MXMU= 10 ,  MXPHl=24.  MXY=30.  MXSIGY=3) 

PARAMETER(MXGEOP=MXMU» (MXPHl /2  ♦  1)) 

C 

COMMON/ CRTS  I G/  RHOHAT { MXMU , MXMU . MXS I Gv )  . TAUHAT ( MXMU . MXMU , MXS I G V )  . 

1  GE0PP(MXMU,MXGE0P,MXSIGY) .GEOPM(MXMU.MXGEOP.MXSIGY) 

COMMON/CGRID/  FMU(MXMU) .PHI (MXPHI ) . YOUl (MXY) .BNDMU(MXMU) . 

1  BNDPHI (MXPHI ) .OMEGACMXMU) , 0£ L TMU ( MXMU ) 

COMMON/CMl SC/  IMISC(20) .FMISC(2u) 

COMMON/CWORK/  R AOSK Y ( MXMU . MXPh I ) ,PHASE(2701 .MXSIGY) , 

1  CKSUM(MXMU . MXV ) 

C 

NMU  =  IMISC(l) 

NPHI  =  IMISC(2) 

NL  =  IMISCO) 

NSIGY  =  IMISCC5) 

IDBUG  -  IMISCO) 

TwOPI  =  2.0*FMI5C(1) 

RADEG  =  FMISC(3) 

L 

DELPHI  -  TWOPI /FlOAT(NPhI ) 

NQPI  =  NPhI/2 
NOPI  1  =  NOPI  1 
L 

00  50  I  Y  =  1  .MXSKw 
DO  50  J-I.MXGEOP 
DO  50  I-1,MXMU 
GEOPPl I  . J.  lY)  ^  0. 

5U  GE0PM( I  . J ,  I  V )  =  0 . 

LOOP  OVER  The  DEPTHS  (Y  INDEX)  WHERE  I  HE  OPTICAL  PROPERTIES  OF 
THE  WATER  ARE  DEFINED. 

DO  100  lY^l.NSIGV 

LOOP  OVER  The  R.  U,  And  V  OUAD  INDUES 

DO  100  IU=1.NMU 
C 

DO  100  IR=l.NMu 
C 

NCOMPV  -  NOPI  1 

IF(IU.EQ.NMU  .OR.  I  R  .  EQ  .  NMiJ  )  NCOMPV  -  1 

DO  100  I V=l, NCOMPV 
C 

C  select  the  SUBUuAD  RESOlcTIuN.  IDEtillLAL  OR  ADJACENT  QUADS  INVOLVE 

C  FORWARD  SCATTERING,  AND  NEED  HIGHER  RESOLUTION  TO  RESOLVE  THE 

c  Phase  function  accurately 

I F 1  I  V . L  E . 2 )  then 

IFCIR.EQ.IU  .OR.  IR.EU.IU^l  .OR,  IR.EQ.IU-1)  THtN 

c  input  and  Output  quads  are  ideniicag  or  adjacent 

NUQ  =  INCBAS’NUQB 
NvO  =  1NC8AS*NV0B 

else 

NUQ  =  NUQB 
NVQ  =  NVQB 
ENDIF 
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ELSE 

NUQ  =  NUQB 
NVQ  =  NVQB 
ENDIF 

C 

C  BOUNOARITES  OF  THE  MU  (=  lU)  QUAD 

UMUMIN  =  0. 

IF(IU.GT.l)  UMUMIN  =  BNDMU(IU-l) 

DMU  -  DELTMU( IU)/FL0AT(NU0) 

UO  =  UMUMIN  +  0.5*DMU 
C  SIZE  OF  THE  PHI-J  SUBQUAOS 

1F( lU.EQ.NMU)  THEN 
DPHl  =  TWOPI /FLOAT(NVQ) 

Else 

OPHI  =  DELPHI /FuOAT(NVQ) 

ENDIF 

C 

C  BOUNDARIES  OF  THE  MU  PRIME  (=  IR)  QUAD 

RMUMIN  =  0. 

IFIIR.GT.l)  RMUMIN  =  BNDMU(IR-l) 

DMUP  =  DELTMUC IR ) /FLOAT(NUQ) 

UOP  =  RMUMIN  »  0.5»DMUP 
C  SIZE  OF  THE  PHI  PRIME-L  SUBQUADS 

I F ( IR . EQ . NMU)  then 
DPHIP  =  TWOPI /FlOAT(NVQ) 

ELSE 

DPHIP  =  DELPHI /FlOAT(NVQ) 

ENDIF 

C 

fact  =  DMU»DPHI»OMIIP»OPHIP/OMEGA( lu) 

C 

C  BOUNDARIES  OF  THE  PHI  (=  IV)  QUAD 

PHIMIN  =  BNDPHI(NPHI) 

IF(IV.GT.l)  PHIMIN  =  BNDPHI(IV-l) 

PHIO  =  PHIMIN  »  0.5*DPHI 

COMPUTE  THE  STORAGE  INDEX  8Y(U.7) 

I F ( IR . EQ. NMU)  Then 
KCOL  =  lU 

else 

I F ( I U . eo . NMU  )  then 
KCOL  =  NMU 
ELSE 

I F  ( 1  V  .  L  E  .  NL+  1 )  Then 
KCOL  =  I U  ♦  NMU* ( I  V- 1 J 
ELSE 

KCOL  =  lu  *  NMU»(NL  ■  MOD (  I  V "  1  .  N L  )  ) 
ENDIF 

ENDIF 

ENDIF 

INTEGRATE  OVER  PHI  PRIME  ONLY  FOR  ThE  PmI  PRIME 
PHIOP  =  BNDPHI(NPHI)  ♦  0.5*DPHIP 

compute  the  QUADRUPLE  INTEGRAL  (11.3)  OVER  THE 

SUMP  =  0 . 

SUMM  =  0. 

DO  1 10  JU= 1 , NUQ 

DEFINE  A  MU  VALUE 
UMU  =  UO  *  F LOAT ( JU- 1 ) *DMU 
ROOTJU  =  SQRT'1.0  -  UMU»UMU) 

DO  110  JR=1,NUQ 

DEFINE  A  MU  PRIME  VALUE 
RMUP  =  UOP  +  float ( JR-1 ) *DMUP 
ROOTJR  =  SORT! 1.0  -  RMUP*RMUP) 

A1  =  UMU»RMUP 
A2  =  ROOTJU*ROOT jR 

DO  110  JV=1,NVQ 

DEFINE  A  PHI  VALUE 
vPHi  =  PHIO  *  Float ( jv- 1 ) »DPHi 
f. 
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DO  110  JS=1.NVQ 

c 

C  DEFINE  A  PHI  PRIME  VALUE 

SPHiP  =  PHIGP  Float  (  js- 1 ) »dphi  p 

c 

C  COMPUTE  CONTRIBUTIONS  TO  INTEORAlS 

COSPPP  =  COSIVPHl  -  SPMIP) 

C 

COSPSI  =  A1  +  A2»C0SPPP 

1 F( ABSICOSPSI )  . GT .  1 . 0)  COSPSI  =  S I GN (  1 . 0 . COSPS I ) 

GET  PSI  IN  DEGREES  AND  DO  A  TABLE  LOOKUP  FOR  PHA SEF ( V . COSPS I ) 

PSI  =  HADEG»ACOS( COSPSI ) 

IF{PSI .lE. 10.0)  Then 
IPSI  -  IFIXCPSI»I00.  +  1,51 
Else 

IPSI  =  IFIXIPSI*IO.  901.5) 
endif 

Sump  =  sump  phasec  ipsi  ,  i  v) 


COSPSI  -  -A1  *  A2»C0SPPP 

I  F  (  ABS(  COSPSI  ).  GT  .  1 . 0  )  COSPSI  =■  S  I  GN  (  1 . 0  .  COSPS  I  ) 
PSI  =  RADEG*ACOS{ COSPSI ) 

IF(PSI , LE. 10.0)  then 

IPSI  =  IF1X( PSI * lOU .  »  1.5) 

else 

IPSI  =  IFIX(PSI*10.  »  901.5) 

ENDIF 

SUMM  =  SuMM  PHASE!  IPSI  .  lY) 

110  continue 


GEOPP! IR . KCOL  ,  I y  ) 
100  GEOPM! Ifi . KCOL ,  I  V  ) 


GEOPP! IR , KLUL . 1 V  )  »  SUMP*FAC1 
GEOPM! IR.kCOl . I  V)  Y  SUMM»FACT 


COMPUTE  the  check  ON  THE  TOTAl  SCATTERING.  (11.5) 


L 


i. 

c: 


L 


c 

c 

c 


WRI r£(b, 208) 

DO  200  IV^I.NSIGv 
WRITE(6,212) 

DO  200  IR=1,NMU 
POLAR  LAP  OulPUI  UUAD 

Sump  =  (GEOppc IR .nmu . i v)  »  geopmc ir .nmu . iv) ) »om£ga ( nmu ) /omega c ir ) 

DO  202  IU-1 ,NMu-  1 

FACTR  =  OMEGA ( lU ) /OMEGA (IR ) 


GEOPM! IR,IU.Iv))»FACrR 


PhI  -  0  VALUEf 

SUMP  =  SUMP  »  (GEUPRk IR . lU, 1 Y) 

PHI  =  PI  VALUES 
KCOL  =  NMU*N0PI  *  lU 
IF( IR.EO.NMU)  KCOL  =  lU 

SUMP  =  SUMP  *  ( GEOPP! IR , KCOL . I Y )  '  GEuPM! I R , KCOL . I Y ) ) • F AC TR 

U  .LT.  PHI  .LT,  PI  values 

DO  202  IV=2,N0PI 

KCOL  =  NMU*(IV-1)  y  iu 

I  F  !  1  R  .  EQ  .  NMU  )  K  ,:Ol  =  IU 

102  SUMP-  SUMP  Y  2 . 0* (GEOPP! IR . KCOL . I Y)  <  GEOPM! I R . KCOL , I Y ) )  FACTR 
CKSUM!IR,IY)  =  SUMP 

:00  rtRITE(6,210)  I  V .  I R . SUMP , GEOPP (  I R .  I R .  I Y ) 


USE  the  checksums  TO  REDEFINE  ThE  FORWARD  SCATTERING  QUADS  BY  11.7 


DO  300  I V= 1 . NSIGY 
DO  300  I R= 1 , NMU 

300  gECPP (  I R , I R  ,  I Y  i  -  1.0  -  CKSuMIIR.Iv)  ^  uEuPP ( I R  ,  1 R  ,  I  Y  ) 


I  F  (  I  DBUG  ,  GE  .  1  )  '►'EN 

call  P3ARAY(G£uPP,  nmu  .  4*NM(/  .  K  S  I  u  Y  .  AIX  MU  .  MXGEOP  ,  2  . 

1  • Quad- AVERAGED  P^ ! V ; R . 1 / U , V ) ' ) 

call  POARAVIGEUPM.NMU.  4  *NM|,  .NSIGv  .M»M(..M)UiEUP,2. 

1  ■ quad-averaged  p- ( y ; r .  1 /u  .  V )  ■  ) 

ENDIF 

208  FOR.MA  T  (  IHU  ,  '  L  ME  L.  K  SUM  S  ON  UUAD- A  .  LRAviEU  GEOMETRIC  P+  AND  P"  FUNCTIO 
1NS'//1H  ,2x,'Y  R  sum  (=1)  CUMPuTED  FWD  SCAT’) 

210  F0RMAT(1H  ,  I  3 .  15 . F  I  1 . 5 .  1PE2U . 3 ) 

212  FORMAT! IH  ) 

RETURN 

END 
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SUBROUT INE  OASKVCRSKV, CARD. SHTOTl . THETAS , PHIS) 

C 

C  ON  NHM4/QASKV 

C 

C  THIS  routine  COMPUTES  THE  INPUT  SKV  QUAD- AVERAGED  RADIANCE 

C  DISTRIBUTION,  USING  3.3  EVALUATED  AS  IN  APPENDIX  B  OF  THIS 

C  MEMO.  SEE  ALSO  STEP  7A4  ON  PAGE  130. 

C 

C  RSKY  IS  the  RATIO  OF  SKY  TO  TOTAL  SCALAR  IRRADIANCE. 

C  RSKY  =  0.0  FOR  A  BLACK  SKY  (SUN  ONLY).  RSKY  =  I.U  FOR 

C  NO  SUN 

C  CARD  IS  THE  CAROIOIDAL  PARAMETER.  CARO  =  0.  FOR  A  UNIFORM 

C  CARD  =  2.  FOR  A  CAROIOIDAL  SKY 

C  SHTOTl  IS  The  TOTAL  (SKY  »  SUN )  SCAlAR  IRRADIANCE  ON  ThE 

C  WATER  SURFACE  FROM  ABOVE 

C  THETAS,  PHIS  ARE  THE  SUN  SOURCE  ANGLEb  (IN  DEGREES.  RELAII 

C  PHI  =  0.  IN  The  DOWNWIND  DIRECTION) 

C 

C  UPON  RETURN.  RADSkY  IN  'CWORK/  hOlOS  ThE  QUAD- AVERAGED  SFY 

C  RADIANCES  for  use  IN  AMPAO  IN  MAIN. 

C 

PARAMETER ( MXMU= 10 ,  MXPHI=24.  Mxv-3U) 

C 

COMMON/CGRI D/  FMU'MXMU ) , PHl (MXPhI ) , V ( MXY ) , BNDMU ( MXMu ) , 

1  0NDPHI (MXPHI ) ,OMEGA(MXMU) 

COMMON /CM I  SC/  IMl SC ( 20)  . FMI SC ( 2u ) 

COMMON/CwORK/  RADSKV (MXMu .MXPhI ) . IhEIAB(MXMU) .PHIB(MXPhI ) 

C 

NMu  -  imisc( n 

NPHI  =  IMISC(2) 
lOBuG  -  IMISCCOj 
PI  =  FMISCC  I) 

RAOEG  =  FMISC(3) 

SET  UP  The  BACKGROUND  SKY  QUAD ■ A vER AGED  RADIANCES  USINu  B. 

WRITE(6,500)  SHTQTl. RSKY. CARD 
FNO  =  RSKY»SHTOTl / ( 2 . 0*PI ♦ (  1 . 0  f  u.b'LARDJ) 

00  100  I=l,NMU'l 
RAD  =  FN0«(1.0  ^  CARD*FMU(1)) 

DO  100  J=1,NPhI 

100  RAOSKY ( I . J )  -  RAD 

POLAR  CAP 

R AOSKY ( NMU , 1 )  =  FNO*(1.0  '  lARU* FMU I NMU ) ) 

ADO  IN  The  sun  to  the  APPROPRIATE  QUAD  USING  B.8 
wRiTE(6.502)  Thetas, PHIS 

CONVERT  THE  BOUNDARY  MU  AND  PHI  VALUES  TO  DEGREES 
00  101  1=1. NMU 

101  THETAB(I)  =  RADEG»ACOS(BNDMU( I J ) 

DO  103  J=1.NPHI 

103  PHIB(J)  =  RAOEG'BNOPhI ( J ) 

determine  the  (mu.phi)  indices  uf  the  Quad  containing  the 

PH  =  AMOniPHIS  -  360..  360.) 

DO  201  1=1. NMu  1 

I  F  (  thetas  .  L  T  .  ThET  AB(  I  )  AND.  T  mE  '  A  s  .  GE  .  I  HE  T  AB  (  I 1  )  )  IMUS  = 

201  continue 

1 F ( ThET AS . Gl  .  The T AB (  1  )  )  IMus  =  1 

DO  202  J  =  1  , NPf  1 
I  F  (  PH  .  L  T  .  PHie  (  J  )  )  GO  TO  206 

202  continue 

J  1 

206  JPHIS  =  J 

200  continue 

C 

the  =  RADEG»ACUS(FMU( IMuS) ) 

WRI TE(6,510)  IMUS, J Phis. The .RADEg*PHI (jPhIS) 


tech 


SKY  , 


VE  TO 


7 


SUN 


I  I 
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c 

c 


c 


c 

c 

c 

c 


CHANGE  PHI  INDEX  FROM  SOURCE  LOCATION  TO  BEAM  DIRECTION 

JPHIS  =  MOOIJPHIS  t  NPHI/'2.  NPHI  I 
I F ( JPHI S . EQ . 0)  JPHIS  =  NPhI 
IF ( IMUS. EQ. NMU)  JPHIS  =  1 

RADSKVl IMUS, JPHIS)  =  RAOSK V { I MUS . JPHl S )  ♦ 

1  (1.0  -  RSKY)*SHTOTL/OMEGA(IMuS) 

I F ( IDBUG . NE . 0)  CALL  P2ARA V ( R AD SK V . NMU . NPH I . MXMU , 2 , 

1  •QUAD-AL'ERAGEO  sky  RADIANCES  ) 

RETURN 

FORMATS 

bOO  F0RMAT(1h1.  TmE  input  RADIANCt  UlblHlBUTlON  HAS'// 

15X,  -total  SCALAR  IRRADIANCE  t  Suti  »  Sk.y  )  =',1PE10.3. 

2'  watts  per  square  meter  /  ■ 

J5X, 'RATIO  OF  SkV  to  TQTAL  SCALAR  IRRACHANLE.  R  ='.0PF6.3// 
45X , ' CAROIOIDAl  parameter.  C  -  .Fo.j) 
b02  FORMAT!//'  THE  SUN  IS  REOuESTEO  AT  SKV  LOCATION  (ThETa.  PHI) 
1  FA . 1 .  ,  , F5 . I , • )  ) 

SIO  FORMAT!//'  THE  SUN  IS  Pl.ACED  IN  UUAD  OIR.SI  =  Q !  '  ,  I  2  .  '  .  '  .  I  2  . 
1')  CENTERED  AT  (THETA.  PHI)  =  !  .Fb.J.  .  .F/.3.')') 

END 


( 


SUBROUT 1n£  RFMPAk!X.V.Z.1ROw. NMU .  !. ) 

ON  NHMA/ REMPAX 

THIS  ROUTINE  FORMS  THE  MATRIX  PRODUCT  X  •  V  -  Z,  WHERE  x  AND  Z 
ROW  VECTORS  AND  VISA  BLOCK  MATRIX  STORED  ON  ThE  PACKED  FORMAT 
OF  12.4. 

DIMENSION  X (  1 )  , V !  I  ROW ,  1 )  . Z !  1 ) 

C 

LPl  ^  L  1 
00  100  JZB=1.LP1 
JZ82  =  L/2  »  1 

I  F  (  MOD!  JZB  .  2  )  .  E  J  0)  JZB2  =  (L-xIi/Z 
J2  =  (J7B-1)*NM^ 

jv  =  !  (  jZB»  1  )  /  .'  -  1  )  *NMU 

C 

Du  2UU  I  -  1  . NM^ 

Sum  =  u 

DO  301  KX  =  1  .  jZB.' 

KV  -  2*KX  -  1 

IF(MODi  jZB.2)  EO.OI  kV  =  2*^x 
12  -  (  K  V  1  )  * 

DO  301  K  =  1  . NM. 

30  1  Sum  =  Sum  x  !  ;  2  ►  k  i  *  v  i  i  2 »  k  .  i  > 

200  Z ( j2x I i  X  SUM 
100  CONTINUE 
C 

RETURN 

END 


ARE 
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subroutine  RHOTAU(L) 

ON  NMM4/RH0TAU 


THIS  ROUTINE  COMPUTES  THE  DISCRETIZED  SPECTRAL  PHASE  FUNCTIONS 
RHOHAT  and  TAUHAT  from  The  QuAD'AvERAGED  geometric  scattering 
functions.  the  governing  EQUATIONS  ARE  5.6  AND  5.208  TO  5 . 20E . 


PAHAMETER(MXMU=IQ,  MXPhI =24 .  Mxy=aO.  MXSIGV=3) 

PARAMETER(MXGE0P  =  MXMU»{MXPMI/'2  »  D) 

COMMON/CSIGV/  VSIGIMXSIGV) . A l BE S S I MXS I G V ) 

COMMON/CGRID/  FMu'MXMu) .PHI (MxPHt ) 

COMMON /CRTS  I G/  RhOhAT (MXMU .MXMu .MXSIGV )  . TAUHAT (MXMU , MXMU .MXSIGV)  . 

1  GEOPP ( MXMU , MXGEOP .MXSIGV). GEOPM ( MXMu . MXGEOP .MXSIGV) 

COMMON/CMISC/  IMISC(20) 

COMMON/CWORK/  COSlPV(MXPhI ) 

NMU  =  IMI SC ( 1 ) 

NPHI  =  IMISC(2) 

NL  =  !MISC(3) 

NSIGV  =  IMISC(5) 

00  100  !V=1.NPhI 

100  COSLPV(IV)  =  COS{FlOATIL)»PhU Iv) ) 

IFIL.EQ.U  .OR.  L.tO.NL)  then 
EPSl  =  FlOAT(NPHI ' 

Else 

EPSl  =  FlOAT(NL) 

ENOIF 

LOOP  Over  The  oepths  where  the  inherem  optical  properties  are  given 

00  200  I V= 1 . NSIGv 
albedo  =  AlBESSI  I  V  ) 

POlAR  cap  output.  Iu  =  NMU 


IFIl.EO.U;  then 

c 

FMUl  =  I  .  U,' FMu  I  NMU  I 

C  Quad  I^4PuT;  use  5.200.  PriA  T  Is  GIvEN  8v  5 . 6C 

DO  300  IR  =  1  . NMu-  1 

RhOHA T (  I R , NMU .  i V  )  =  ALBEDO»ePSL ’uEuPMl  IR .NMU .  I  V ) ‘FMU 1 
300  TAuhAT i  I R . nMU ,  I  V  )  =  AlBEOO’EPSl'GEOPP (  I R . NMU .  I  V ) ‘FMU I 
C 

C  POLAR  CAP  INPUT;  USE  5.206.  PHA I  IS  GIVE  Bv  5 . 6D 

RHOHAT  (  NMU  .  NMU  ,  I  V  )  =  A  L  BE  DO  *  GE()PM  I  NMU  .  NMU  .  I  V  )  »  F  MU  1 

TAUHAT ( NMU , NMu ,  1 V )  =  ( A L BE DO * GE 0 PP ( NMU . NMU .  I  V )  -  1.0)«FMUi 

V, 

Else 

c 

DO  302  I  R  =  1  ,  NMl. 

RmOhA T (  1 R . NMu .  I  V  )  =  0. 

302  TAUHA  T  (  I  R  ,  NMU  .  :  V  ;■  =  0. 

ENOIF 

(, 

^  Quad  (rjuN-POuAF  CAP)  Output 

(. 

UO  3  10  I U=  1  , NMu  1 
FMu  1  =  1  .  0  /  fmi.  ;  I  j  I 

I 

RUl  AR  (,AP  INP  ■  IR  =  NMu.  USE  5.ZUi.  .  PHA  T  IS  GIVEN  BV  5  .  BB 


r 


(Ml  .  fcO  .  0  ) 

ThEn 

kM>.)HA  T  (  NMu 

.  I '  ‘  ,  i  '  1 

=  ALBEttU* 

NWLI  . 

]  )  ,  I  V  !  ♦ FMu  1 

TAUHAT ( NMu , 
h  L  S  E 

,  I  u  . :  V ) 

-  AlBEDO^UEGPP  ; 

f-jMii  . 

!  L)  .  :  V  )  *FMu  1 

PmOh A  T  (  NMu , 

I  U  .  !  V  ) 

=  0  . 

TAv..,mAT(NMu, 

,  lu  ,  1  V  ) 

=  G. 

ENOIF 
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QUAD  (NON-POLAR  CAP)  INPUT;  USE  6.2UB,  PHAT  MUST  NOW  BE 
COMPUTED  BV  5.6A 

DO  310  IR=1,NMU-1 
SUMP  =  0. 

SUMM  =  0 . 

DO  400  IV=1,NPHI 

COMPUTE  STORAGE  INDICES  BY  (12.7) 

I F ( I Y . LE . NL>  1 )  Then 

J  =  lU  ♦  NMU« ( I  V-  1  ) 

ELSE 

j  =  lU  NMU»(NL  -  MODI  I V-1  ,NL)  ) 

ENDIF 

SUMP  =  SUMP  GEOPP(  IR  ,  J  ,  I  V  ) ‘COSCPy  (  1  V) 

400  SUMM  ^  SuMM  GEOPM  (  I  R  .  J  ,  1  Y  )  *  COSLP  y  (I  V  ) 

RmOHAT (  I R .  lU ,  I  V  )  -  albedo* SUMM*FMU 1 

I F ( IR . EQ . I U )  Then 

OELT  -  1. 

Else 

DElT  =  0. 

ENDIF 

310  TAUMAT( IR , lU, I y )  -  (ALBED0*SUMP  -  DElTi*FMU1 

(, 

200  continue 

L 

RETURN 

L 

END 


subroutine  RICA’  i  (  L  ) 

L 

C  ON  NMM4/RICATI 

C 

C  TmIS  routine  so.  vES  FOR  THE  ARRAYS  RYA,  -  R(Y.X)  AND  Txy  -  T(X,Y) 

1.  BY  integrating  0.43  AND  6.44  In  A  DUnNivARD 

L  SWEEP  with  INITIA,  values  OF  Rv'x.a)  -  0  AND  T(X,X)  =  I,  BV  6.47, 

L  RVB  -  R(Y,ai  is  FOUND  BY  INTEGRATInu  6.4a  IN  AN  UPWARD  SWEEP 

L  wi Initial,  llnuition  riz.b)  ^  r-<at(z.b).  by  6.BB. 

L  ;hE  arrays  RVx  and  ’XV  are  stored  in  the  .'ECTOR  RT  AS  FOLLOWS 

(.  iFOR  A  GIVEN  Y  -AlUE): 


L 

L 

C 

c 


RYX(I.J)  IS  RT(1  •*  lj-n*NMU) 

TXy(I,j)  IS  R’ll  ♦  (J-1)*NM-.J  N'vV.j»NMlj) 

PARAMETER (MXMU- 10 ,  MXPHIi24,  Mxv-Ju) 
parameter  (MXEut.=  Z*MXMU*MXMU  ) 

DI  MEr  s  I  or*  COVER  f  (  24  ) 
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COMMON /CRTR/  RVXCMXMU ,MXMu .MXY) . Txv (MXMU , MXMU .MXY ) . 

1  R I VB ( MXMU , MXMU .MXY). R2VB(MXMU . MXMU . MXV) 

COMMON /CBOTBC/  RMA TZB ( MXMU . MXMu ) 

COMMON /CGR  ID.'  FM'i  vMXMu  )  .  Pul  (MXPhI  )  .  V  (  MXV  ) 

COMMON/ CM 1  SC/  IMI SC  C  20)  . FMISCI 20 ) 

COMMON/CWORX/  wERx(MXE0n.9)  .RKMxEQN) 

C 

c  Subroutine  drtab  evaluates  the  rhs  of  6.43.  6.44  and  6.48 
external  drtab 

c 

NMU  =  IMI SCI  1 ) 

NV  =  IMISC(4) 

IDBUCi  =  IM:SC(9) 

IBOTM  =  IMISCI 12) 

NMU 2  =  NMu»NMU 
NEONS  =  2*NMU2 
TOl  =  FM1SCI7) 

I F ( IDBUG . GE . 1 )  WRITEC6.3002)  TOl 

initialize  the  arrays  at  y  -  X  USING  6.47 

DO  500  1=1. NMU 
DO  500  J=1,NMU 
RVX ( I . J . 1 )  =  0 . 

RT I  I - ( J~ 1 ) *NMU )  =  0 . 

DELT  =  0. 

I F { I  . EQ . j  )  DElT  =  1  . 

TXV( I . J . 1 )  =  DElT 

500  RT(  I » ( J -  1 J *NMU‘NMu2 )  =  OElT 

YSTART  i  V(  1  ) 

CDPREV  =  0. 

IMI SCI  13)  =  1 
I  NO  =  1 

INTEGRATE  6.43  AND  6.44  TQ  FIND  RIv.xi  AND  T(X.Y)  AT  EACH  Y  LEVEL 
00  520  IV'Z.NV 

VEND  =  YSTART  <•  V(IY)  -  Y  {  I V  -  1) 

I  F  (  I  DBUG  .  GE  ,  1 )  .‘,RITE(6, 3000)  YSTART. vENO 

CA_l  D vERRINEQNS. drtab, VSTAR'  .RT  .VEND.''0L.  INO.CDvERy  ,M).FQN. 

1  WERX ,  I ER  ) 

C 

IDEV  =  tDvERYi:4)  -  COPREv 
CDPREv  =  lDvERinv24) 

IF  I  I OBUG . GE .  1 ;  WR I TE ( 6 , 300  1  )  IDEv 
IFIInO.lE.O  .or,  lER.GT.O)  TmEn 
WRI TE I  6,  1060 )  IMI SCI  13 )  ,  IND ,  I ER 
STOP 
ENDI  F 
L 

C  SAVE  the  SOLUTI.JN  at  Y  -  VEND 

L 

DO  520  3=1, NMU 
DO  520  1=1, NMU 

RYXlI.J.lY)  =  RT  (  I -^  (  J- 1  )  *NMU  ) 

520  TXyII.J.IV)  =  RT(I  (J-1)*NMU  ♦  NMU2  ) 

C 

C  integrate  6.4H  FROM  Z  TO  X  TO  FIND  Rllv.BI  AT  EACH  v  lEVEl 

C 

r  initialize  at  V  =  z  with  rKZ.B)  =  PhaTUZ.B).  using  6.58 

DO  550  J=1.NM' 

DO  550  1=1, nMl 
RlvBII.J.Nv)  =  RhaTZBII.J) 

550  RT  (  1  ♦  (  J- 1  )  YNMi.!  I  i  RhATZBII.J) 

L 

YSTART  =  Y{NV) 

NEONS  =  NM02 
CDPREV  =  0. 

IND  =  1 

IMI SC (  1  3  I  =  2 
c  Integrate 

DO  5  70  I V= 1  , NV -  1 
I VRE V  =  NY  -  I  ' 

VEND  =  YSTART  -  VllYREV-*-!)  +  VlIVRtV.i 
I  F  (  IDBUG.  GE  .  1  ;  w'R  I  TE  (  6, 3000  )  YSTART, VEND 
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CALL  OVERK(NEQNS,DRTA8,vSTART.RT.vEND,TOL,IND.CDv'EPK,MXEQN. 

1  WERK.IER) 

C 

lOEV  =  CDveRK(24^  -  COPRfcV 
COPREV  =  CO\/ERK(24) 

I  F  (  IDBUG.  GE  .  1  )  WRITE(b.300U  IGEv 
IFdNO.LE.O  .OR.  lER.GT.O)  ThEN 
WRITE(6, 1060)  IMIbC(  13)  . INO,  lER 
STOP 
ENOI  F 
r 

C  SAVE  THE  SOLUTION  AT  VEND 

DO  570  3=1, NMU 
DO  570  1=1, NMU 

570  R  1VB( 1  . J ,  I VREV )  =  R T { I » ( J -  1 ) * NMu I 
C 

C  USE  R2(Y.B)  =  R1(V,6)  OR  INTEGRATE  6  46  AuA I N ,  ACCORDING  TO  THE 

C  BOTTOM  TYPE 

L 

I F ( I BOTM . EQ . 0  .AND.  L.EQ.O)  THEN 

L 

C  MATTE  BOTTOM  w/ITh  L  =  0.  INTEGRATE  AGAIN  WITH  INITlAl  CONDITION 

C  R2(Z.B)  =  0 

L  note  added  in  PROOFING;  I  DO  NUT  IHINK  TmIS  INTEGRATION  IS 

C  NECESSARY;  JUST  SET  R2{Z.B)  =  0.  SINCE  AMP2  =  0.  HOWEVER,  THIS 

L  HAS  NOT  BEEN  CHECrED  8v  lOMPARING  EAch  COMPUTATION.  SO  I  MAY  BE 

C  MISSING  SuMEThInG.  CM.  2  JUNE  88. 

L 

DO  595  J=l.NMu 
00  595  1=1. NMU 
R?yBiI.J.NY)  =  0, 

59  5  RT  I  I •  I  J •  1 ) ‘NMU '  -  0 . 

C 

YSTART  =  Y ( NY ; 

NEQns  =  NMU2 
CDPREV  =  U. 

IND  =  1 
IMISCI 13)  =  2 
c  integrate 

DO  597  IY=1,NY  1 
IyREV  =  NY  -  IV 

VEND  =  ySTART  -  V(IVREV»1)  ■-  VlivnEV) 

IF ( IDBUG.GE . 1 )  wRITEie, 3000)  YSTART, VEND 
C 

CALL  DVERK(NEQNS,ORTAB,YSTART,RT,YeNO,TOL,lND,CDVERK,MXEUN. 

1  WERK,IER) 

C 

IDEV  =  CDvERK(24)  -  CDPREV 
CDPREV  =  CDVERK(24) 

I  F ( lOBUG . GE .  1 )  WRITE(6,3001)  IDEv 

ifcino.le.o  .or.  ier.gt.o)  then 

WRITE(6, 1060)  IMISCI 13) , IND, lER 

stop 

ENDIF 

SAVE  THE  SOLUTION  AT  VEND 
DO  597  J=l,NMu 
DO  597  1=1, NMU 

597  R2Vclv;,J,IYRCv.i  =  RTII'fJ  IJ'NHv) 


C  MATTE  bottom  WITH  L . GT . 0  OR  INFINI'El'  DEEP,  HOMOGENEOUS  LAYER. 

C  USE  R2(y,B)  =  RKy.B) 

0 

DO  biiO  I  V  =  1  .  Nv 
DO  600  J=l,NM:j 
DO  600  1=1. NMu 

600  R2YB(I,J,IY)  =  RlvB(I,J,Iv) 

L 

ENDIF 

(. 

RETURN 

C 

1060  FORMAT!/  SUB  RICATI;  ERROR  IN  (AlI  TO  OvERK :  IDE  =  '  ,  I  5 . 5X , 

1  I  NO  --  ,  I  5  ,  S,--  ,  ■  I  ER  =  •  ,  I  5  ) 

3000  FORMAT!  vSTARi  =  .F8.4,5/<.  VEND  -'.68.4) 

300  1  FORMAT (  IH* , T40 .  I  4 ,  DERIVATIVE  EVALUATIONS  ) 

3002  FORMAT!/////  UUTPUr  FROM  INTEGRATION  ROUTINE  DvERK  ( T OL  =  , 

I  IRE  1 2 . 3 ,  '  )  '  i 
END 
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§5.  PROGRAM  4 


subroutine  V2ZGE0 
ON  NMM4/V2ZGE0 

THIS  ROUTINE  COMPUTES  THE  GEOMETRICAL  DEPTHS  ZETA  (IN  METERS)  WHICH 
CORRESPOND  TO  THE  OPTICAL  DEPTHS  V  ( NOND I  MENS  1 ONA L )  WHERE 
OUTPUT  IS  requested. 

EQUATION  7.1  IS  INTEGRATED.  WHEREIN  ALPHA  IS  A  FUNCTION  OF  OPTICAL 
DEPTH  V 

PARAMETER  (MXMU=10,  MXPHl=24.  MXV=30.  MXS1GV=3) 

COMMON /CGRIO/  FMU( MXMU ) . PHI (MXPhI ) . VOUT { MXV ) . BNDMU (MKMU I , 

1  BNDPHI (MXPHI ) .OMEGA (MXMU) . DE LTMu ( MXMU ) , ZGEO(MXY ) 

COMMON /CS I  Gy/  YSlG(MXSIGY).ALa£SS(MXSIGY).TOTALS(MXSIGY) 

COMMON/CMI SC/  IMISC(20) 

external  FALPhA 

data  AERR . RERR/0 . 0 .  l.OE-8/ 

NY  =  IMISC(4) 

NSIGY  -  IMISC(5) 

AlPHAI  =  AlBESSI 1 ) /TOTALS) 1 ) 

I F ( NSIGY . EO . 1)  then 

WATER  COLUMN  IS  uniform  WITh  OEP'^h 

DO  100  IY=1,ny 

100  ZGEO(IY)  =  Alpha i*youT( I Yj 

else 

WATER  COLUMN  HAS  VARIABLE  OPTICAi  PROPERTIES  WITH  DEPTH;  INTEGRATE 
OZETA  -  0Y/AlPmA(V) 

2GEO(l)  -  AlPhAI’VOUT (  1  ) 

DO  200  ly=2,NY 

200  ZGEO(IV)  -  ZGEO(IY-I)  *•  OCADRE  (  F  At  PhA  ,  VOUT  (  I  Y  -  1  )  ,  YOUT  (  I  y  I  . 

1  AERR , RERR . ERROR . I  ERR  ) 

C 

ENDI  F 

return 

END 
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6.  PROGRAM  5 

A,  Program  Description 

This  program  first  synthesizes  the  radiances  from  the  amnlitndes  found  in  Program  4. 
Then  the  results  are  analyzed  and  derived  quantities  are  computed,  as  detailed  in  75/§8.  Multiple 
runs  of  Program  5  can  be  made  for  a  given  set  of  output  from  Program  4.  For  example,  one  run 
can  be  made  to  check  the  balance  of  the  radiative  transfer  equation,  another  run  to  compute  the 
irradiances  and  other  derived  quantities,  etc. 

We  note  again,  as  discussed  in  75/§7a,  that  the  expensive  computations  for  the  quad- 
averaged  upper  boundary  r  and  i  arrays  need  be  done  only  once  for  a  given  wind  speed  and  quad 
resolution.  Likewise,  the  expensive  discretization  of  the  phase  function  is  a  one-time  comput¬ 
ation  for  a  given  phase  function.  The  actual  solution  of  the  radiative  transfer  equation  in 
Programs  4  and  5  is  relatively  inexpensive.  Therefore,  holding  the  wind  speed  and  phase  func¬ 
tion  fixed,  it  is  possible  to  mtike  many  runs  of  Programs  4  and  5  in  order  to  study  the  effects  of 
varying  the  incident  radiance  distribution,  the  scattering-to-absorbtion  ratio  s/a  =  (o/(1-cd),  the 
bottom  boundary  type,  etc.  It  is  often  convenient  to  make  a  run  of  Programs  4  and  5  with 
radiance  output  (see  record  5  of  Program  4  and  records  2,  4  and  5,  below)  at  some  standard  set  of 
depths,  say  at  y  values  of  0.0,  0.5,  1.0,  2.0,  5.0,  10.0.  and  20.0  optical  depths  (here 
YOUT(l)  H  X  =  0.0  and  YOUT(NY)  s  z  =  20.0,  with  NY  =  7).  If  inspection  of  this  run  indicates 
a  "region  of  interest"  (e.g.  large  changes  in  the  radiance  field  with  depth,  or  "kinks"  in  the 
K-function  curves)  between  y  -  2.0  and  y  =  5.0.  say,  then  another  run  of  Programs  4  and  5  can 
be  made  to  give  greater  resolution  in  the  region  of  interest.  The  second  run  could  save  the  output 
at  y  values  of  0.0.  1.0,  2.0,  2.5.  .'.0,  3.5,  4.0,  4.5,  5.0,  10.0  and  20.0  (now  NY  =  11). 

In  addition  to  the  specific  analyses  selected  by  the  input  records  below,  a  basic  "skeleton" 
of  radiance  values  is  always  printed  (e.g.  upward,  downward  and  horizontal  radiances  in  the 
alongwind  and  crosswind  directions  at  selected  depths,  cf.  subroutine  RADY). 

Other  u.seful  quantities  automatically  computed  and  printed  are  the  contrast  transmittance 
(cf.  75/§8k  and  subroutine  CONTRM),  and  the  backward  and  forward  scattering  functions  (cf. 
7.5/§8d  and  subroutine  BFSC.'‘  T).  If  dc.^ired,  this  output  can  be  removed  by  deleting  the  calls  to 
the  appropriate  subroutines. 

Additional  output  is  included  where  convenient  in  many  of  the  subroutines.  For  example, 
path  functions  (cf.  7.5/§8g)  are  computed  along  with  the  radiance  K-functions  (subroutine 
KRAD).  Distribution  functions  (75/8.1 1  )  and  reflectance  functions  (75/8.14)  are  computed  along 
with  the  irradiances  (subroutine  IRRAD).  Eccentricities  (75/8. 16b)  are  included  with  the  back¬ 
ward  and  forward  scattering  functions. 

B.  Input 

From  five  to  nine  frec-fomiat  records  are  read  to  specify  the  type  of  analysis  desired. 
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Record  1:  ITITLE 

This  is  an  alphanumeric  title  for  the  run,  used  to  identify  the  printout.  Up  to  80  characters 
are  allowed. 

Record  2:  IPRAD,  IPRADl,  IPRAD2,  IPRAD3,  JPRADl,  JPRAD2,  JPRAD3 

This  record  (along  with  record  2a,  if  required)  specifies  the  extent  of  printout  of  the 
radiance  distribution  by  subroutine  PRINT. 


IPRAD 

<  0 

if  a  printout  of  the  radiance  distribution  is  desired  at  every  y  level 
where  the  radiance  was  computed:  y  =  a,  YOUT(l)  = 

X,  ■•,YOUT(NY)  =  z 

IPRAD 

=  0 

if  no  printout  of  the  radiances  is  desired 

IPRAD 

>0 

if  printout  is  desired  only  at  certain  y  levels,  IPRAD  in  number,  to  be 
specified  in  record  2a 

IPRADl, 

IPRAD2, 

IPRAD3 

are  DO-LOOP  indices  of  the  form 

DO  302  I=IPRAD1,  IPRAD2,  IPRAD3 
which  select  the  |i- bands  of  quads  for  which  printout  is  desired.  For 

example,  consider  the  m  =  10  by  2n  =  24  quad  partition  of  75/Fig.  4a. 
There  are  m=  10  |i-bands  in  each  hemisphere  (|i  ,  u  =  l,  ",m).  If 
(IPRADl,  IPRAD2,  IPRAD3)  =  (1,  10,  1)  then  all  p-bands  will  be 
printed.  If  (IPRADl,  IPRAD2,  IPRAD3)  =  (1, 10,  3)  then  only  bands 
u  =  1,  4,  7  and  10  are  printed  out  (the  polar  cap  values,  u  =  m,  are 
always  printed).  See  DO-LOOPs  302  and  103  in  subrouting  PRINT 
(where  index  I  is  u). 

JPRADl,  are  DO- LOOP  indices  which  select  the  (j)-bands  to  be  printed,  ())  , 

JPRAD2,  v  =  l,  •,2n.  Referring  again  to  75/Fig.  4a,  if  (JPRADl,  JPRAD2, 

JPRAD3  JPRAD3)  =  (1,  24,  1)  then  all  <))-bands  would  be  printed.  If 

(JPRADl,  JPRAD2,  JPRAD3)  =  (1,  24,  6)  then  only  the  <>-bands  at 
V  =  1,7,  13,  19  (corresponding  to  <))  =  O',  90',  180',  270'  in  75/Fig. 
4a)  are  printed.  See  DO-LOOPS  302  and  103  in  PRINT  (where 
index  J  is  v). 

Record  2a:  IYPRAD(1),  -,IYPRAD(IPRAD) 

This  record  is  read  only  if  IPRAD  >  0.  The  values  of  lYPRAD  are  the  j  indices  of  yj, 
j  =  l,  -,YOUT,  at  which  printout  is  desired.  (See  75/Fig.  6  and  input  record  5  of  Program  4, 
where  y^  is  YOUT(J).) 

Record  3:  IRTECK,  NIC,  NJC 

This  record  specifies  whether  or  not  the  balance  of  the  radiative  transfer  equation  (RTE)  is 
to  be  checked;  see  75/§8a  and  pay  special  attention  to  75/8.3  and  the  requirement  of  closely 
spaced  y^  values. 
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IRTECK  <0  if  the  balance  of  the  RTE  is  to  be  computed  at  all  possible  interior 
y-levels,  YOUT(2),-,YOUT(NY-l) 

IRTECK  =0  if  no  RTE  balance  check  is  to  be  made 

IRTECK  >0  if  record  3a  gives  the  indices  of  the  y-levels  where  the  RTE  check  is 

to  be  made.  Normally,  the  RTE  is  checked  only  at  the  center  y-level 
of  three  closely  spaced  y-levels  (see  75/8.3).  Thus  if  the  user  plans  to 
check  the  RTE,  foresight  must  be  shown  in  specifying  the  y-levels  in 
record  5  of  Program  4.  "Closely  spaced"  y-levels  are  separated  by, 
say,  0.01  optical  depths.  Thus  a  choice  of  y-levels  in  record  5  of 
Program  4  might  be  0.0,  0.99,  1.00,  1.01,  4.99,  5.00,  5.01, •••.  The 
balance  of  the  RTE  could  then  be  checked  at  levels  1.00  and  5.00. 

NIC,  NJC  are  DO-LOOP  increments  used  to  select  particular  p  and  (|)  values  where  the 
RTE  balance  is  to  be  checked.  See  DO-LOOPs  300  in  subroutine 
RTECK,  which  are  of  the  form 
DO  300J=  1,NPHI,  NJC 
DO  3001=  1,2*NMU,  NIC 
where  |i(I)  is  in  E  if  I  <  NMU 
and  p(I)  is  in  5'^  if  NMU  <  I  <  2*NMU 

Record  3a:  IYRTE(1),-  -,IYRTE(IRTECK) 

This  record  is  read  only  if  IRTECK  >  0.  lYRTE(J)  is  the  index  j  in  75/8.3.  It  is  assumed 
that  y..i,  yj  and  yj^j  are  closely  spaced.  Note  that  lYRTE(l)  >  2  and  lYRTE(IRTECK)  <  NY-1. 

Record  4:  IPIRAD 

This  record  (and  record  4a  if  required)  specifies  the  y  levels  at  which  irradiances,  distribu¬ 
tion  functions,  and  reflectances  are  printed  out.  (Irradiances,  etc.  are  automatically  computed  at 
all  y-Ievels,  e.g.  for  use  in  computing  K-functions,  but  are  printed  out  only  at  desired  levels.) 

IPIRAD  <0  if  the  irradiances,  etc.  are  to  be  printed  out  for  all  y-levels 

=  0  if  irradiances  are  to  be  printed  out  only  at  levels  y^,  j  =  1,  2,  4,  6,  8,-  -. 

This  is  convenient  when  YOUT  (Record  5  in  Program  4)  has  speci¬ 
fied  closely  spaced  pairs  of  depths,  as  is  convenient  for  computing 
K-functions  (see  subroutines  KFCN  and  KRAD) 

>0  if  the  irradiances  are  to  be  printed  out  only  at  selected  y-levels, 
IPIRAD  in  number,  to  be  specified  in  record  4a 

Record  4a:  IYIRAD(1),  -,IYIRAD(IPIRAD) 

This  record  is  read  only  if  IPIRAD  >  0.  IYIRAD(j),  j  =  1, -sIPlRAD,  are  the  indices  of  the 
y-levels  whose  irradiance  data  is  to  be  printed  out;  1  <  lYIRAD(j)  <  NY. 
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Record  5:  IPKFCN,  ISTART,  ISTOP,  ISTEP,  JSTART,  JSTOP,  JSTEP 

This  record  (and  record  5a  if  required)  specifies  the  computation  and  printout  of  K- 
functions  for  irradiance  and  radiance,  using  75/8.12  and  75/8.26.  The  y-derivatives  are  estimated 
by  using  consecutive  pairs  of  depths,  i.e.  dy  =  yj^j  -  yj  =  YOUT(j+l)  -  YOUT(j)  if  the  K- 
function  is  requested  at  level  j.  These  derivative  estimates  will  be  inaccurate  if  yj^j  and  yj  are  not 
closely  spaced  —  say,  0.01  optical  depths  apart.  Thus  foresight  must  be  shown  when  specifiying 
output  depths  in  record  5  of  Program  4  if  K-functions  are  to  be  computed. 

IPKFCN  <0  if  irradiance  (and  optionally  radiance)  K-functions  are  to  be  com¬ 
puted  at  all  possible  depths  YOUT(l),  ",YOUT(NY-l) 

IPKFCN  =0  if  the  K-functions  are  to  be  computed  at  levels  y-,  j  =  1,  3,  5,  7,—. 

This  is  convenient  if  record  5  of  Program  4  has  selected  closely 
spaced  pairs  of  output  depths,  i.e.  yj  and  yj  are  closely  spaced,  and 
y^  are  closely  spaced,  etc.  An  example  of  record  5  of  Program  4 
following  this  scheme  is 

0.0, 0.01,0.50,0.51, 1.00,  1.01,2.00,  2.01,-  . 

One  could  then  accurately  compute  K-functions  at  levels 
0.005,0.505,  1.005,  2.005, 
by  using  IPKFCN  =  0 

IPKFCN  >0  if  K-functions  are  to  be  computed  only  at  selected  y-levels,  IPKFCN 
in  number,  to  be  specified  in  record  5a 

ISTART,  are  DO-LOOP  indices  which  select  the  (i-bands  of  quads  for  which 

ISTOP,  radiance  K-functions  are  to  be  computed,  if  ISTART  >  0.  (ISTART, 

ISTEP  ISTOP,  ISTEP)  are  identical  in  form  to  (IPRADl,  IPRAD2, 

IPRAD3)  in  record  2.  See  DO-LOOP  200  in  subroutine  KRAD. 

ISTART  <0  if  radiance  K-functions  are  not  to  be  computed 

JSTART,  are  DO-LOOP  indices  which  select  <)>-bands  of  quads  for  which 

JSTOP,  radiance  K-functions  are  to  be  computed.  See  (JPRADl,  JPRAD2, 

JSTEP  JPRAD3)  in  record  2  and  DO-LOOP  200  in  subroutine  KRAD. 

Record  5a:  IYKFCN(1),  -,IYKFCN  (IPKFCN) 

This  record  is  read  only  if  IPKFCN  >  0.  IYKFCN(j),  j  =  1,  -,IPKFCN,  are  the  indices  of 
the  y-levels  where  the  K-functions  are  to  be  computed;  1  <  lYKFCN(j)  <  NY-1. 

C.  File  Management 

Three  files  are  read  by  Program  5,  and  one  is  written. 
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symbolic  name 

external  name 

description 

NURAX 

TAPE22 

the  quad-averaged  geometric  r(a,x)  array  from 
Program  2 

NUTXA 

TAPE25 

the  quad-averaged  geometrix  t(x,a)  array  from 
Program  2 

NUIN 

TAPE40 

the  radiance  amplitudes  and  other  information, 
generated  by  Program  4 

NUOUT 

TAPE50 

a  file  containing  discretized  phase  functions, 
radiances,  and  other  information,  for  use  by  the 
graphics  routines 

Files  NURAX  and  NUTXA  are  used  only  by  subroutine  CONTRM,  which  computes  the  contrast 
transmittance. 
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D.  Code  Listing 


PROGRAM  MAIN( INPUT , OUTPUT , TAPE5= INPUT .TAPEb=OUTPUT. 

1  TAPE40 . TAPE50 . TAPe22 . TAPE25 ) 

C 

C  ON  NMM5/MAIN5 

C 

Q  +  +  +  +  +  +  +  +  +  +  +  +  +  +  +  +  +  +  +  +  +  +  +  +  +  +  +  + 

C  *  ♦ 

C  THIS  IS  PROGRAM  5  OF  THE  NATURAL  HVDROSOL  MODEL  + 

C  +  + 

Q  +  +  +  +  +  +  +  +  +  +  +  + 

c 

C  this  program  takes  the  spectral  amplitudes  GENERATED  Bv  PROGRAM  4 
C  AND  SYNTHESIZES  THE  GEOMETRIC.  UUAO- AVER AGED  RADIANCE  FIELDS. 

C  VARIOUS  DERIVED  QUANTITIES  ARE  ALSO  COMPUTED.  IF  DESIRED 

C 

C  RAXGEO  (TAPE22)  AND  TXAGEO  (TAPE25).  THE  QUAD- AVERAGED  GEOMETRIC 

C  R(A.X)  AND  T(X.A)  arrays.  ARE  REQUIRED  IF  THE  CONTRAST 

C  TRANSMITTANCE  IS  TO  BE  COMPUTED 

C 

PARAMETER(MXMU= 10 ,  MXPHI=24,  MXY=30.  MXS1GY=3) 

PARAMETER  (  MXL  =MX PH  I  /  2  .  MXGEOP-MXMu*  (MXL-^  1  )  ,  MXAMP  =  2 ’MXMU »  (MXL-f  1  )  ) 
PARAMETER (MXRRTH^MXMU* (MXL» 1 ) .  MXCRTH-MXMU* ( (MXLf 2 ) /2 ) ) 

PARAMETEH( MXWERK -MXMU* ( MXL»  1  ) • (  1 »  2»MXMu) tS^MXY ) 

C 

DIMENSION  I VRTEI MXV ) . I VPRAD(MXV ) . 1 vlRAD(MXY) . I YKFCN(MXY) 

COMMON/ CS I  GY/  YSIG(MXSIGY) . AlBESS(MxSIGY) .TOTALS(MXSIGY) 
COMMON/CAMPO/  AOAM(MXAMP) ,AOYM(MxAMP.MXY) ,A0AP(MXAMP) 

COMMON /CGEOP/  GEOPP(MXMu .MXGEOP .MXSIGY )  . GEOPM ( MXMU . MXGEOP . MXS I  GY ) 
COMMON/CAMP/  AAM(MXAMP) .AAP(MXAMP) . A YM ( MXAMP . MXY ) . A YP ( MX AMP , MX Y ) 
COMMON/CGRIO/  FMU(MXMU) .phi (MKPHl ) . V(MXV) ,BNDMU(MXMU) . 

1  BNOPHI (MXPMI j ,0M£GA{MXMU) . DEL T MU ( MXMU ) ,ZGEO(MXY) 

COMMON/CRAOIF/  RAOAP(MXMU.MXPh1 ) . RADP( MXMU . MXPHI .MXY) . 

1  RADAM(MXMU .MXPHI ) . R ADM { MXMU . MXPH I .MXY ) 

COMMON/CRAOIR/  RaD0AP(MXMU.MXPh1 ) . R AOOAM ( MXMU . MXPH I ) . 

1  RAOOMIMXMU .MXPHI , MXY) 

COMMON/ C I RR AD/  ShP(0 ;MXY ) . SHM(0;MXV) , SCAPHP( 0 ;MXY ) , SCAPHM ( 0 : MXY ) . 

1  DPY(0:MXY) ,DMY(0:MXY) 

COMMON /CKR AD/  I  START . I  STOP .ISTEP.JSTART . JSTOP. JSTEP 
COMMON /CM  I  SC/  IMISC(20).FMISC(20) 

COMMON/CWORK/  WERK(MXWERK) 

C 

DATA  NUOUT/50/ 

INITIALIZE  the  program 

call  ini SHL( IRTECK.IYRTE.IPRAD.IvPRAD.IPIRAD.IYIRAD.IPKFCN.IYKFCN) 
AAM  AND  AYM  NOW  CONTAIN  DIFFUSE  AMPLITUDES  (SAME  FOR  AAP  AND  AYP) 
COMPUTE  IRRADIANCE  QUANTITIES  FROM  ThE  L  =  0  AMPLITUDES 
call  IRRADflPIRAD, lYlRAD) 

NY  =  IMISC(4) 

COMPUTE  the  diffuse  RADIANCES  AT  V  ^  A.  X .  Z 

call  SYNRADl AAM . RADAM . MXMU ) 

DO  100  K=1,NY 

100  call  SYNRAD ( AYM(  1 , K )  . RADM( 1 ,  1  . ^ )  .MaMU I 

C 

call  SYNRAO(AAP.RADAP.MXMu) 

DO  110  1 , NY 

110  call  SYNRAD ( a YP C 1 , K ) . RADR( 1 , 1 . K ) . MXMU ) 

1 

L  COMPUTE  THE  DOWNWARD  DIRECT  RADIANCE  AT  V  =  A,  X .  Z 


112 


UUUU  OUU  UUU  OUO  UtJO  uuu  uwo  uuo 


§6.  PROGRAMS 


CALL  SYNRADlAOAM.RADOAM.MXMU) 

DO  120  K=1.NY 

120  CALL  SVNRAD( AOYMC 1 . K) . RADOMC 1 . 1 . X) .MXMU) 

COMPUTE  THE  UPWARD  DIRECT  RADIANCE  AT  Y  =  A .  THE  UPWARD  DIRECT 

radiance  is  zero  for  Y  =  X .  Z. 

CALL  SYNRAO(AOAP.RADOAP.MXMU) 

PRINT  SELECTED  RADIANCES  AND  COMPUTE  THE  R ADI ANCE - I RR AD 1 ANC E  RATIOS 
CALL  RADY( IPIRAD. lYIRAD) 

COMPUTE  THE  CONTRAST  TRANSMITTANCE 


CALL  CONTRM 

COMPUTE  THE  K  FUNCTIONS  FOR  IRRADIANCE 


CALL  KFCN( IPKFCN. lYKFCN) 

COMPUTE  THE  K-FUNCTIONS  FOR  RADIANCE 
IF( istart.gt.o)  call  KRA0( I PkFCN . 1 vkFCn) 

COMPUTE  THE  BACkSCATTER  AND  FDRwaRD  SCATTER  FUNCTIONS 
call  BFSCATI IPIRAD. IYIRAD) 


print  out  The  radiances 


I  F (  I PRAO . GT . 0 )  (ALL  PR  I  NT ( I  PR AO .  I YPR AD ) 


C 

C 

c 


c 


c 


CHECK  THE  balance  OF  THE  RTE  AT  INTERIOR  Y  VALUES 
I F { IRTECK . NE . U )  call  R T ECK ( I RT ELK . I YR T E ) 

SAVE  The  radiance  information  for  ANALYSIS  BY  THE  PLOTTING  PROGRAM 

NMU  ^  IMI SCI  1  ) 

NPMl  =  IMISC(2) 

NY  =  IMISC(4) 

NSIGY  =  IMISC(5) 
xCOL  -  IMI SC(  10) 


REWIND  NUOUT 

writeinuouT)  IMI sc . fmi sc , FMU 
1  YSIO . AlBESS . totals . ZGEO 
WRITE! NuOuT ) 


PHI , V . BNUMU .BNDPHI . OMEGA. DElT MU. 


(((GEOPPlI.J.Kl.I^l, NMU ) .J=l.KCOL) .K=l. NSIGY) 
( I ( GEOPM ( I . J . K ) . I = 1 . NMU ) .J=1.KCOl) .K=I .NSIGY) 
( IRAOAPI I .J) .1-1 .NMu) . J=1 .NPHI ) 
(IiRADP{I.J.K).I-l, NMU ) . J- 1 . NPMI ) . K- I . NY ) 
((RADAM(I.J).I=1 .NMU ) . I . NPHI ) 

!  :  RADM(  I  .  J  .  K  )  .  I  =  1  .  NMU  ).J=),NPm1).K=:1,NY) 

; ' HADOAPI I . J) . 1=1. NMU) .J= 1 .NPHI ) 
;iHADOAM(I.j).I=l. NMU ) . J= 1 . NPH I ) 
((iRADUM(I.J.X).1=I. NMU ) . 1 .NPHI ) . K= 1 , NY ) 
ZERO-MODE  AMPl  I^UDES 
WRIT£(NU0UT)  ( AUAm; I  )  . I  =  1  . NMU ) 

1  (  ( AOYMf  I  . K  )  .  r  =  1  , NMU )  . I  . NY ) 

write (NUOUT)  ( AAM(  I  )  .  1  =  1. NMU)  .  ( A A  f  •  I 
I  (  ( A YM(  I  .  K )  .  I  -  1  . NMU ).K=l.NY).i(AYPlI.K).I  =  l, NMU )  .  K=  1  . NY  ) 

endfile  nuout 

WH  I  TE  (  f)  .  2UU  I  NUOUT 


WRITE! NUOuT ) 
WRITE! NUOuT ) 
WRITE!  NUOljT  ) 
WRI  TECnuOuT ) 
WRITE! NuOuT ) 
wRI TE( NuOUT ) 
WR I TE ( NUOUT ) 
wRIT£(NuOUT) 


( a0AP( I ) . I = 1 . NMU) . 

).!  =  !.  NMU )  . 
i  (  AVPl  I  . K)  .  I  =  1  , NMU ) 


200  FORMATIIHO.'  TAPE. 12.'  WRITTEN.) 
END 
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subroutine  INISMLIIRTECK, IVRTE. I  PR ad.  IVPRAD.IPIRAO.IVIRAD, 

1  IPKFCN, IVKFCN) 

ON  NMM5/INISHL5 

THIS  routine  INITIALIZES  PROGRAM  5  OF  THE  NHM 
PARAMETER(MXMU=10.  MXPHI=24,  MXV=30.  MXSIGV=3) 

PARAMETER(MXL  =  MXPHI /2 ,  MXGE0P=MXMU»(MXL+ 1)  .  MXAMP  =  2»MXMU* (MXL-f  I )  ) 
PARAMETER(MXRRTH=MXMU» (MXL+ 1) ,  MXCRTH=MXMU» ( (MXL+2 ) /2 ) ) 

DIMENSION  I VRTE(MXV)  , I  V PR ADI MX V)  . I  V IRADIMXV)  . IVKFCN (MX V ) 

DIMENSION  ITITLEHO) 

COMMON/CGEOP/  GEOPP ( MXMU . MXGEOP . MXSl GV ) . GEOPM ( MXMU . MXGEOP . MXS I GV ) 
COMMON/CAMPQ/  AOAM(MXAMP) , AOVM(MXAMP , MXV ) . AOAP(MXAMP) 

COMMON/CAMP/  AAM(MXAMP) ,AAP(MXAMP) . A VM ( MXAMP , MXV ) . A VP ( MXAMP . MXV ) 
COMMON/CGRID/  FMU(MXMU) .PHI (MXPhI ) , V(MXV) ,BNDMU(MXMU) . 

I  BNDPHI (MXPHI ) ,OMEGA(MXMU) . DEL TMU ( MXMU ) ,ZGEO(MXV) 

COMMON/ CS I GV/  VSIG(MXSIGV) . AL8E S S ( MXS 1 GV ) . TOT AlS ( MX S I GV ) 

COMMON /CKR AD/  I  START . I  STOP . TSTEP . JSTART . JSTOP, JSTEP 
COMMON /CPR AO/  I  PR ADI . IPRAD2 . 1 PRA03 . jPRAOl . JPRAD2 , JPRAD3 
COMMON/CMISC/  IMISC(20)  .FMISC(2U) 

DATA  NUIN/40/.  IDBUG/0/ 

READ  HEADER  RECORDS  FROM  ThE  AMPLITUDE  FILE 
REWIND  NUIN 

REAO(NUIN)  IMISC.FMISC.FMO.OH] .y. BNDMU . BnDPhI . OMEGA . DEL TMU . 

1  VSIG.AlBESS. totals. 2GEO 

NMU  =  IMISC(  I  ) 

NPHI  =  IMISC(2) 

NV  =  IMISC(4) 

NSIGY  =  IMISC(S) 

NRHAT  =  IMISC( 10) 

NRAMP  =  2*NRHAi 
RAOEG  =  FMISC(3) 

KCOL  NMU*(NPHl/2  ♦  1) 

READINUIN)  ((( GEOPP (  I  . J  .  K  )  .  I  -  1  . NMo )  .  J -  1 . kLOL  )  . K -  1  . N S I Gv  ) 
REAOtNUIN)  C(lGEOPM(I.J,K).I-l. NMu ).J-1.kCOl).K=1.NSIGV) 

READ  IN  parameters  FOR  RADIANCE  ANALYSIS 

R£AO(5.50)  ITITlE 
WR I TE ( 6 .  lOQO )  I T  I  TlE 

C  READ  SPECIFICA TIONS  FOR  RADIANCE  PRInTu’jT 

c 

R£AD(5.*)  1PRAO.IPRAD1.IPRAU2.IPRAu.5.jPRAD1.JPRAD2.JPRAD3 

I F tl PRAD . lT . 0 )  then 

DO  lOb  ly=I.NV 
106  IVPRAD(IV)  =  IV 
IPRAD  =  NV 

EL  SE I F (  I PRAD . GY . 0 )  then 
READIS.*)  1 IyPRAO( IVl.Iv-l.IPRAui 
ENDIF 
L. 

C  READ  SPECIFICATIONS  FOR  RTE  ChELa 

L 

REAO(5.»)  IPTECK  .MC.NJt; 

I F (  IRT  ECK . lT  , 0 )  Then 
DO  lUB  I ! . NV 
10b  IyRTEIIv)  =  ’.  y 

Fi  SE  1  F  (  I  RTEL  I-  .  uT  .  IJ  I  THEN 
READ15.*)  (IvRTE(Iv).Iv=l.IHTELKl 
ENDIF 
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c  fttAO  specifications  for  irradiance  output 
c 

ft£A0(5,*)  IPIRAD 

c 

tF( IPIRAD, LT.O)  THEN 
00  110  rv=l,NV 
llD  IVIRAD(IY)  =  lY 
IPIRAD  =  NV 

EcSEI F ( IPIRAD . EQ . 0 )  THEN 
IVIRADd)  =  1 
IPIRAD  =  1 
DO  112  IY=2.NY,2 
IPIRAD  =  IPIRAD  1 
112  lYIRADC IPIRAD)  =  lY 
ELSE 

READ! 5 . *)  (IYIRAD(IY).IV=1. IPIRAD ) 

ENDI  F 

READ  SPECIFICATIONS  FOR  K'FUNCTION  OUTPUT  AND  RADIANCE  K-FUNCTION  DIRECTIONS 

READ! 5 . • )  IPKFCN ,  I  START ,  I  STOP . 1  STEP . JST ART . JSTOP , JSTEP 

IF( IPKFCN. lT . Oi  TnEN 
DO  114  IY=1,NY-1 
114  lYKFCN(IY)  =  IV 
IPKFCN  -  NY  -  I 
ELSEI F ( I PKFCN . EQ . 0 J  THEN 
IPKFCN  =  0 
DO  116  IY= 1 ,NV-  1  .  2 
IPKFCN  -  IPKFCN  >  1 

116  I YKFCNI IPKFCN)  -  lY 

else 

READ! 5 , • )  ( I YKFCNI  I Y )  .  I Y =  1  .  I PKF CN ) 

ENDIF 

IM1SCI9)  -  IDBU& 

IMISCI 15)  =  NIC 
IMI SC( 10)  =  NJC 

RECORDS  written  By  MAIN4  (DIRECT  BEAM) 

R£AD(NUIN)  (  AuAMi  I  )  ,  I  ■=  1  .  NHAMP  ) 

DO  15  J= 1 .NY 

15  REAO(NUlN)  ( AOVM ( I , J ) , I = 1 . NRAMP J 
RE  AD ( NU I N )  ( aOa  P (  I  )  .  I  = 1  . NRAMP ) 

C 

C  ( total  beam ) 

READ(NUIN)  ( A AM ( I ) . I = I . NRAMP ) 

READ(NUIN)  ( AAP ( I ) , I = 1 , NRAMP ) 

00  16  J=1.NV 

1F>  READlNUlN)  (  A  YM  I  1  .  J  1  ,  I  -  1  .  NRAMP  ) 

DO  17  J  =  1  , NV 

17  READINUIN)  I  AY P (  I  .  J  )  ,  I  -  I  , NRAMP  I 

f 

c  printout 

( 

I  F  (  I  DBUD  .  DT  ,  0  j  :^1EN 

wR I  re ( 6 ,  10  1b) 

wR I TC ( 6 ,  102  2 i 
DO  1020  I-1.NM-; 

TmETA  =  RAOEG*A^05( FMU( I ) ) 
lo2i)  wR  1  Tt  (  b  .  Ic24  I  ;  ,  'HE  TA  ,  FMul  I  ) 

wRI Tt( o. 10/ b/ 

DO  1029  J-  1  .  t.KHi 

1029  WR  1  1  E  I  R  .  lll.ill  )  .J  ,  RAOED*  PHI  I  J  1 

wR I TE ( b . 1032 ) 

DO  1 034  K -  1  , NV 
10. <4  WRI’'El'b.IU'ibl  K,Y(K) 

ENDI  F 


115 


'O  Cj  u  U  c_)  u 


§6.  PROGRAMS 


IF( IDBUG.GE. 2)  THEN 
WRITE(6. 1038) 

call  PNTAMP(V.AQAM.A0VM,MXAMP) 

WRiTE(6. 1039) 

CALL  PNTAMP( V , AOAP . 1 . E201 .MXAMP) 

WRITE(6. 1040) 

CALL  PNTAMP(y,AAM,AVM. MXAMP) 

WRITE(6. 1042) 

CALL  PNTAMP(V,AAP,AYP, MXAMP) 

ENDIF 

CONVERT  THE  DOWNWARD  TOTAL  AMPLITUDES  TO  DIFFUSE  AMPLITUDES 
AT  Y  =  A,  X,...,  Z  BY  8.23 

CONVERT  the  UPWARD  TOTAL  AMPLITUDES  TO  DIFFUSE  AMPLITUDES  AT  Y  =  A . 
The  UPWARD  TOTAL  =  THE  UPWARD  DIFFUSE  FOR  Y  =  X .  Z, 

DO  600  I=1,NRAMP 
AAM(I)  =  AAM(I)  -  AOAMd) 

AAP(  I  )  =  AAP( I  )  -  A0AP( I  ) 

DO  600  K=  1  ,  NY 

600  AYM(I,K)  =  AYM(I,R)  -  AOYM(I.K) 

I F ( IDBUG . GE . 2 )  THEN 
WfiITE(6. 1044) 

call  PNTAMP(Y.AAM,AVM. MXAMP) 

WRITE(6, 1046) 

CALL  PNTAMPC Y . AAP . AYP .MXAMP  ) 

ENDIF 

L 

RETURN 

L 

C  FORMATS 

C 

SO  FORMAT!  10A8) 

1000  FORMAT!  IHl,'  PROGRAM  5  OF  THE  NATURAL  HYDROSOL  MODEL  // 

1'  synthesis  and  analysis  OF  i-hE  radiance  FIELDS’// 

2 '  RUN  title ;  ’  .  10A8  ) 

1018  FORMAT! IHO,'  THE  RADIANCE  FIELDS  APE  COMPUTED  AT  THE  FOLLOWING  GR I 
ID  values : ■ ) 

1022  FORMAT!1hu,'  THE  IHETA  VALUES  ARE'//  I  THETA bX MU '/ ) 

1024  FORMAT!1h  , is , F 10. 3 , F  10.4  ) 

1026  F0RMAT!1HU.’  the  PhI  VALUES  ARE'//'  J  PHI'/) 

1030  format (  ih  .  I  5  .  F  10 . 3  ) 

1032  FORMAT! IHO,  ThE  Y  VALUES  ARE'//'  K  OPT  DEPTH’/) 

1036  FORMAT! IM  .IS,4X.F7.4) 

1038  F0RMAT(1h1.  The  DOWNWARD  DIRECT  BEAM  RADIANCE  AMPLITUDES  ARE’// 

1  IIX.  MU'  .7X,  'A0!A.-)’  .8X.'A0(Y.-)’  ) 

1039  F0RMAT(1H1.'  The  upward  direct  beam  radiance  amplitudes  ARE’// 

1  1 IX .  • MU ’  . 7X .  ’ AOl A  .  +  )  ’  ) 

1040  FORMAT!lHl.'  THE  DOWNWARD  TOTAL  RADIANCE  AMPLITUDES  ARE’// 

1  IIX.  MU'  .7X,  AlA.-)'  .9X.  ’A!Y.-)'  ) 

1042  F0RMAT!1H1.'  The  upward  total  radiance  amplitudes  ARE’ 

1//I1X,  MU’  .7X.  AIA.’-I'.gx.  A!Y,ty'  ) 

1044  FORMAT!  IHI.'  ThE  DOWNWARD  DIFFUSE  RAtUANCE  AMPLITUDES  ARE’// 

1  1  M  .  MU  .  7X  .  A  *  I  A  .  -  )  ■  , ax .  A • (  Y  ,  )  I 

1046  FORMAT! IHI.  TmE  upward  DIFFliSE  RADlANlE  AMPLITUDES  ARE'// 

1  1  1  X  .  MU  ■  .  7X  .  A  *  I  A  .  <•  )  ■  .  8x  .  A*!y.-)  ) 

E  NC) 
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:iubroijtine  bpscat(ipirao.  ivirad) 

(. 

C  ON  NHM5/BFSCAT 

c 

C  this  routine  computes  the  BACKSCATTER  functions  AND  B(Z,-) 

C  USING  8.15.  FORWARD  SCATTER 

C  FUNCTIONS  F(Z,>)  AND  F(Z.-)  ARE  COMPUTED  FROM  EQ .  8.16. 

C  COMPUTED  values  ARE  CHECKED  USING  EQ .  8.17. 

c  the  eccentricities  are  also  computed. 

c 

PARAMETER ( MXMU= 10 ,  MXPHl =24 ,  MXy=30.  MXS1GV=3) 

PARAMETER(MXl  =  MXPhI /2 .  MXGEOP  =  MXMU* (MXL-H  )  ) 

C 

DIMENSION  IVIRADIMXY.) 

C 

COMMON/ CGR I D/  FMU(MXMU ) , PHI (MXPHl ) , Y(MXV) . BNDMUCMXMU ) , 

1  BNDPHI tMXPHi ) ,OMEGA(MXMU) . OE LTMU ( MXMU ) . ZGEO(MXV) 

COMMON/ CRAD I F /  RADAP ( MXMU , MXPHl ) . RADP( MXMU .MXPHl , MXY ) , 

1  RAOAM  C  MXMU , MXPhI  )  . RADMfMXMU .MXPHl  . MXY ) 

COMMON / CRAD 1 R /  R ADO AP (MXMU .MXPHl ) . RADOAM(MXMU .MXPHl ) . 

1  RADOM(MXMU. MXPHl , MXY) 

COMMON /CGEOP/  G£OPP(MXMU.MXGEOP.MXSIGY)  . GEOPM ( MXMU . MXGEOP . MX S I  GY ) 
COMMON/ CIRRAD/  HP ( 0 ; MX Y ) . hM ( 0 ; Mxy ) . C APHP ( 0 : MXY ) . C A PHM ( 0 : MX Y ) . 

1  DPY(0:MXVJ .0MV(0:MXV) 

COMMON/ CS I  GY/  VSlG(MXSIGy).ALBESS(MXSlGY).TOTALS{MXSlGV) 

COMMON /CM  I  SC/  IMISC(20).FMISC(20J 

COMMON/CWORK/  GEOPPY(MXMU. MXGEOP) . GEOPM Y ( MXMU . MXGEOP ) .QZPV(MXY) . 

1  BZMY(MXY),FZPY(MXY).FZMY(MXV). SY (MXY ) 

DATA  EPS/I.E-12/ 

C 

NMU  =  IMI SC( I ) 

NPhI  =  IMISC(2) 

NSIGY  =  IMI  $C{‘=  ) 

nRha  r  =  IMI  sc  (  :  i.. ) 

NOPI  =  NPhI/2 
wR I X£ ( 6 . 300) 

C 

DO  99  I  I Y  =  I  .  I  PI  RAD 
IV  =  IVIRAD(IIV) 

SuMBP  =  0. 

SuMBM  =  0. 

SUMFP  =  0. 

SUMFM  =  0. 

BZP  =  -  1  . 

BZM  =  -  1  . 

FZP  =  -  1  . 

FZM  =  -  1  . 

SVFMBP  =  -1. 

BBARP  =  -  1  . 

BBARM  =  -  1  . 

SMFMBM  =  -  1  . 

L 

YNCa  =  Y(IY) 

L 

C  COMPui'E  the  Quad- averaged  geometric  phase  function  at  the  needed 
f.  Y  value  By  LINLmk  1  N  I  CRf-OLAT  ion  OF  ThE  known  values 

c 

I  F  (  Nl,  I  G  Y  ,  £0  .  1  .UR,  YNOW.  LE  .  VblGl  1  )  j  InEN 

s  =  TOTALS!  1 ; 

00  50  J-1,NRhA7 
(jU  5(j  1  =  1. NMl 

OEuRT'Y  I  1  .  j  =  .jLOPP  I  1  ,  J  .  1  ) 

5u  ’jEOPMvil__)  =:  .jEOPM(I,j,l) 

f 

tLSE  I  F  i  VNGVV  .  (jt:  V  s  I  G  (  NS  I  Civ  M 
S  ^  “^OTAlSInSIC^V  ) 

00  5  2  j -  1  .  NRmA  T 
00  5  2  I  -  1  . N  M 1  / 

G  E  0  R  F'  V  f  ]  ^  j  )  ^  'i  E  P  P  n  ,  j  ,  S  I  V  ) 

5  2  GEOPM  V  (  I  .  j  )  -  GE  GPM  C  I  .  j  ,  S  I  G  V  ) 
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else 

DO  55  JV=2.NSIGY 
IF(YN0W.LT.VSI&( jy) )  GO  to  56 

55  CONTINUE 

56  DV  =  (YNOW  -  ySIG( JV-1) )/( YS1G( JV)  -  VSIG(JY-l)) 

S  =  (1.0  -  DY)*T0TALS(JY-1)  »  DY»TOTALS( JV) 

DO  58  J=1,NRHAT 
DO  58  r=l.NMU 

GEOPPYCI.J)  =  Cl.O  '  OY)*GEOPP( I . J . JY-1 )  ♦  DY *GEOPP C I  .  J  .  J Y  ) 
58  GE0PMY(I,J)  =  (1.0  -  DY ) ‘GEOPMC I  . J , JY- 1  )  ♦  DV*GE0PM( I  , J . JV ) 


SV ( lY)  =  S 
DO  100  IU=1.NMU 
OUV  =  OMEGA(IU) 

IVMAX  =  NPMI 
1 P ( 1 U . EQ . NMU)  IVMAX  =  1 
DO  100  IV=1, IVMAX 
SUMBP2  =  0. 

SUMBM2  =  0. 

SUMFP2  =  0. 

SUMFM2  =  0. 

DO  200  1R=1,NMU 
ISMAX  =  NPHI 
IF( IR . EQ . NMU)  ISMAX  =  1 

DO  200  I S= 1 , I SMAX 

COMPUTE  the  storage  INDEX  FOR  P-(R.U,V)  AND  P-^(R,U,V)  BY  12.7 

IVS  =  IABS( rv-is) 

I  F  (  IR  .  EU  .  NMU  )  TFIEN 
KCOL  =  lU 

else 

I  F  (  lu  .  EQ  .  NMU  )  TFIEN 
KCOL  =  NMU 
ELSE 

I F ( I  VS . LE , NOPI  )  then 
KCOL  =■  lU  +  NMU*IVS 
ELSE 

KCOL  =  lU  +  NMIJ*(N0P1  -  MODI  I  vS  .NOPI  )  ) 

ENOIF 

ENDIF 

ENDI  F 
C 

PP  =  GEOPPV( IR , KCOL ) 

PM  =  GEOPMY ( IR . KCOL ) 

C 

RPTOTL  =  RAOP(  I  R  ,  I  S  ,  I  Y  )■ 

RMTOTl  =  RAOM(  I  R  ,  I  S  .  I  Y  )  R ADOM (  I  R  ,  I  S  .  1  Y  ) 

C 

SUMBP2  =  SUMBP2  +  RPTOTL*PM 
5UMBM2  =  SUMSM2  RMTOTl'PM 
SUMFP2  =  SUMFP2  RPT0Tl»PP 
200  SUMFM2  =  SUMFM2  +  RMT0TL*PP 
C 

SUMBP  =  SUMBP  ♦  QUV»SUMBP2 
SuMBM  =  SUMBM  QUY*SUM8M2 
SUMFP  -  SUMFP  -  QUV*SUMFP2 
100  SUMFM  i  SuMFM  •>  QUV*SUMFM2 
C 

!  F  (  CAPhPI  I  Y  )  .  (,E  .  EPS  *5*  SUMBP)  THEN 
CAP  =  S/CAPHP(  I  /  ) 

F2P  =  SUMFP'CAP 

BZP  =  SuMBP*  CAP 

SUP  =  HP  I  I Y )  •  lap 

SMFMBP  =  SDP  -  FZP  -  BZP 

BBARP  =  BZP/DPY ( I Y ) 

ENDIF 
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I  F  (  CAPHM{  I  Y  )  .  CiE  .  EPb»S*SUMBM)  TmEN 
CAP  --  S/CAPHM(IY) 

FZM  =  SUMFM»CAP 

BZM  =  SUMBM»CAP 

SDM  =  HM( I y ) «CAP 

SMFMBM  =  SDM  -  FZM  -  BZM 

BBARM  =  BZM/DMY(IY) 

ENDIF 

C 

BZPy(IV)  =  BZP 
BZMV(IV)  =  BZM 
FZPV(IV)  =  FZP 
FZMV(IV)  =  FZM 
C 

99  WRITE (6, 302)  IV. V( IV) .ZGEOI IV) , BZP . BZM . FZP , F ZM , SMFMBP, SMFMBM, 

1  BBARP. BBARM 
C 

c  eccentricities 

c 

WRI T£ ( 6 . 400 ) 

DO  402  1  1 v= 1 . ip: rad 
I y  =  I y IRAQI  I  I  V ) 

DPSl  =  1 . 0/ (DPy (  I y ) • SY ( I Y  )  ) 

DMSl  =  1 . 0/ ( DMV ( I Y ) ‘SY ( I  V  )  ) 

402  WRITE(fa,410)  IY./(lY). ZGEOI 1y).B2Py(1Y)»DPS1.BZMY(IY)»DMS1. 

1  FZPY ( I Y ) »DPS 1 . F2MY( I Y ) »DMS 1 
C 

RETURN 

C 

C  FORMATS 

C 

300  FORMAT! .// '  BACKWARD  AND  FORWARD  SCATTERING  FUNCTIONS', 

1  •  (DIMENSIONS  OF  1/METER)'// 

2'  lY  Y  ZGEO 6X  ,  'B(  Y  ,  +  )',  8X  ,' B(  V  .-)',  8X  ,' F  (  Y  ,<•)',  8X  , 

3  ' F ( y ,-)■. 6X ,'( S-F-B )(»)', 4X ,'( S- F-B) { - )', 6X , ' BBAR ( * ) ' , 7X , 

4  • BBAR( -  ;  •  /  ) 

302  FORMAT ( I  5 . 2F 7 .  2 .  IPSE  14 .  3) 

400  FORMAT!//'  ECCENTRICITIES'//'  lY  Y  ZGEO ' , 

1'  EPSB(y.»)  EPS8(V,-)  EPSF(V,y)  EPSF(y,-)'/) 

410  format ( I5,2F7.2,F13.4,JF15.4) 

END 


L 

c 

r 

C 

c 

C 


c 


I. 

c 


Subroutine  comrm 

ON  Nf-1M5  /  RUN  T  RM 

ThIj  routine  t.uMPUIES  The  uUNT.,^-.!  THANbMl  TTANCE  via  8.32. 

The  UUAO-AvERA'.EO  OEOMETfiir  A6UAVS  kA«(.EO  and  txageo  are  required. 

PARAMF  TER  (  MXMii- 1  0  .  MX  PH  I  =24.  M.y=f,j) 
parameter  (  MXROvv-MxMu’MXPhI  ) 

COMMON /CR  AD  IF  /  RADAP(MXMU.MxPM1  )  .  R  A  U  (  MXMU  ,  MX  Prt  I  .MXY  )  . 

1  RADAM( MXMU . MuRm I ) 

COMMON/CRADI R /  RADOAP ( MXMU . MX Pm I j . R ADUAM( MXMU . MXPHI ) 

COMMON/ CM  I  SC  /  IMISC.  (20) 

COMMON /CwERK /  RA  XGEOIMXROW )  . Tx A GE D ( MxMu ) 

DATA  IDBuG/0/.  r4uRAX/22/.  NUTxA/25/ 
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NMU  =  IMISC(l) 

NPHI  =  IMISC(2) 

C 

C  READ  The  first  NMU  COLUMNS  OF  THE  STORED  TOP  HALF  OF  RAXGEO, 

C  BUT  SAVE  ONLV  COLUMN  NMU  (THE  POLAR  CAP  OUTPUT  DIRECTION) 

C 

NROW  =  NMU*NPHI 

NROW2  =  NROw/2 

REWIND  NURAX 

REAOtNURAX)  NUNIT 

I F ( NUNI T . NE . NURAX )  THEN 

WRITE(6.102)  NUNIT. 'NURAX- .NURAX 

STOP 

ENDIF 

DO  710  J=1.NMU 

710  READ(NURAX)  ( R AXGEO ( I ) . I = 1 . NROw2 ) 

C 

C  DEFINE  THE  BOTTOM  HALF  OF  THE  POLAR  CAP  OUTPUT  DIRECTION  FROM 

C  THE  TOP  half 

C 

DO  712  I =NR0W2» 1 , NROw 
712  RAXGEO(I)  =  RAXGEOC I-NROW2) 

C 

C  READ  The  FIRST  NMu  ROWS  OF  THE  rlRST  NMU  COLUMNS.  TO  GET  TXA(M../M..) 

REWIND  NUTXA 

READ(NUTXA)  NuNIT 

IF ( NUNI T . NE . Ni ''aA )  THEN 

WRITE(6,lC2j  NUNI T  .' NUTXA '. NUTXA 

STOP 

ENDIF 

DO  720  J=1.NMU 

720  READ(NUTXA)  ( TXAGEO ( I ) . I = 1 . NMU ) 

C 

C  EQUATION  8.33 

RADOT  =  RADP(NMU , 1 . 1 ) »TXAGEO(NMU ) 

C 

RADOR  =  ( RA00AM( NMU . 1 )  *  RADAM( NMU , 1 ) ) •RAXGEO ( NMU ) 

00  8U0  JS=1.NPhI 
00  800  IR=1.NMU-1 

800  RADOR  =  RADOR  +  ( R ADO AM ( I R . J S )  »  RA0AM(IR  JS))* 

1  RAxGeo( IR*NMU» ( US- 1  )  ) 

C 

I F I  lOBuG . NE . 0  )  then 

WRI TEC6 .400 )  ( RAXGE0( I ) . 1= 1 .NROW) 

W«ITE(b.402)  ( TXAG£0( I ) . 1=1 .NMU) 

WRITE(6.404)  RADOT, RADOR 
ENDIF 


C 

C 


CTRANS  =  RAD0r/(RA00T  +  RADOR) 


WR I TE ( 6 . 100 ) 
RETURN 

100  FORMAT! //// ■ 
102  FORMAT {  IMC ,  ' 
400  FORMAT (  IHO ,  ’ 
402  FORMAT ( IHO . ' 
404  FORMAT  I  IHO .  ’ 
END 


( TRANS 


^ME  ^.ONTRAST  TRANSMITTANCE  IS  T  =-,F6.3//) 

i:rror  in  Sub  contrm;  nunit  =-,i3.'  and  •  .ab,  ■  ='.I3) 

SUB  CONTRM;  n ( A . X ; R . S/M .  .  )  VALUES ' / ( 2X ,  1 P lOE  1  2 . 4  )  ) 
TfX.A:R.l/M..)  VALUES' /(2X, 1P10E12.4)) 

RADOT  = ' . IPE12 . 4 .5X . ■ RADOR  ='.E12.4) 
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Subroutine  irrad( ipirad. i virad) 

c 

C  ON  NHM5/IRRAD 

C 

C  THIS  ROUTINE  COMPUTES  VARIOUS  IRRADIANCE  QUANTITIES  FROM  THE  L  = 

C  TOTAL  radiance  AMPLITUDES.  USING  B.5  AND  0.8. 

c  IRRADIANCES  ARE  COMPUTED  AT  ALL  V  LEVELS.  FOR  POSSIBLE  USE  IN 

c  COMPUTING  K-FUNCTIONS.  ETC..  BuT  PRINTOUT  IS  ONLY  AT  SELECTED  V 

C  LEVELS. 

C 

C  the  zero  ELEMENT  OF  IRRADIANCE  ARRAYS  HOLDS  THE  VALUES  FOR  V  =  A 

C 

PARAMETET(MXMU=10.  MXPHI=24.  MXY=30) 

PARAMETER(MXAMP=2»MXMU» (MXPHI/2  ♦  1)) 

c 

DiMEN'^iON  ! v:rad(:,'yv) 

L 

COMMON/CAMPO/  AOAM(MXAMP) , AO YM( MXAMP . MX Y ) ,A0AP(MXAMP) 
COMMON/CAMP/  AAMIMXAMPJ .AAP(MXAMP) . A VM( MXAMP , MX V ) . A VP ( MX AMP , MX V ) 
COMMON /CGR ID/  FMU ( MXMU ) . PHI (MXPMl ) . V(MXV ) , BNDMU(MXMU) . 

1  BNDPHI (MXPHI ) .OM£GA(MXMU) . DEL TMu ( MXMU ) .ZGEO(MXY) 

COMMON/ C I RRAD/  ShP ( 0 : MXV ) , ShM( 0 ; MXY ) , SCAPHP( 0 ; MXV ) , SCAPHMCO ; MXY ) 
1  DPY(0:MXV) ,DMV(0:MXY) 

COMMON /CM I  SC/  IM[SC(20)  .FMISC(2U) 

DATA  EPS/l.E-12/.  FTOTAl/1./ 

SET  FTOTAl  =  1.  IF  total  RADIANlES  ARE  TO  BE  USED 
SET  FTOTAL  =  0.  IF  DIFFUSE  RADIANCES  ARE  TO  BE  USED 

NMU  =  IMI SC (  1  ) 

NY  =  IMISC(4) 

TWOPI  =  2 . ‘FMI SC ( 1 ) 

COMPUTE  quantities  AT  V  =  A 

HP  =  0. 

HM  =  0  . 

CAPHP  =  0. 

CAPhM  =  0. 

DO  140  1=1, NMU 
AMPP  =  AOAP( I )  -  AAPl I ) 

AMPM  =  AOAMC I ) 

DMU  =  OELTMU ( I  ) 

MP  =  HP  AMPP»OMU 
HM  =  HM  ♦  AMPM'DMU 
CAPhP  =  CAPHP  ♦  AMPP*FMU( I ) ‘DMU 
140  CAPHM  =  CAPhM  AMPM*FMU{  I  )*DMU 
C 

5hP(0)  =  TwOPI*HP 

SHM(O)  =  TWOPI »MM 
SCAPHP(O)  =  TwOPI*CAPmP 
SCAPMM(O)  =  TwOPI’CAPHM 
C 

TOTH  =  SHPIO)  ♦  Sl<M(Q) 

DP  =  -1.0E2U2 
DM  =  -1.0E202 
RM  =  -  1 , 0E202 

I  F ( SCAPHP(O)  .GT . EPS*SmP(0)  )  DP  = ShP ( 0 ) / SC APHP ( 0 ) 

I F ( SCAPMM( 0 ) . GT . EPS*SHM(0) )  DM  =  ShM ( O ) / SC APMM ( 0 1 
I F ( SCAPHMI 0  I  . GT . EPS*SCAPHP( 0) )  RM  =  SC APHP ( 0 ) / SC APHM ( 0 ) 

DPV(Q)  =  DP 
OMVCO)  =  DM 
C 

wR  I  TE I  6 , 200 1 

wR I TE ( fa . 203 ;  S’-H I  0 )  . SHM( 0 ) .  TOTn . SLAPHPl U )  . SlAPHM ( 0 )  . DP , DM . RM 
1 F ( F TOT Al . NE . I . )  WRITE(b.201 

C 

DO  100  I  V  -  1  . N V 
HP  =  0  . 

HM  =  0  . 

CAPHP  =  U. 

CAPHM  =  0. 

C 
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C  COMPUTE  IRRADlANCeS  FROM  AMPLITUDES 

C 

DO  150  I=1,NMU 

C  DEFINE  THE  TOTAL  AMPLITUDES  (DIFFUSE  »  DIRECT)  FOR  L  =  0 

AMPP  =  AVP( I . IV) 

AMPM  =  AYMd.lY)  FT0TAL«A0VM(  1  .  1  V) 

DMU  =  DELTMU(I) 

HP  =  HP  +  AMPP»DMU 
HM  =  HM  AMPM»DMU 
CAPHP  =  CAPHP  +  AMPP»FMU{ I ) *OMU 
150  CAPHM  =  CAPHM  ♦  AMPM* FMU ( I ) ’DMU 
C 

SHP(IV)  =  TWOPI*HP 
SHM(IV)  =  TWOPI*HM 
SCAPHP(IV)  =  TWOPI*CAPHP 
SCAPHMdV)  =  TW0PI*CAPHM 
C 

TOTH  =  SHP(IV)  +  SHM(IV) 

DP  =  -1 .0E202 
DM  =  -1.0E202 
RM  =  -1.0E202 

I F ( SCAPHPC I  V )  . GT . EPS*SHP( I  V) )  OP  =  ShP ( I Y ) / SC APHP ( I  V ) 

I F ( SCAPHMC I  V)  . GT . EPS*SHM( I  V ) )  OM  =  SHM( 1 V ) / SC APHM ( I  V ) 

IF ( SCAPHM( I Y )  .GT . EPS*SCAPHP( I  V )  )  RM  =  SCAPHP( I Y ) / SCAPHMI I Y ) 

OPY(IV)  =  OP 
DMV  (  I  Y  )  =  DM 
C 

C  CHECK  FOR  PRINTOUT 

IPRINT  =  0 
DO  300  i:y=i.ipirao 
IF(I V . EQ.  I VIRAD( 11 Y) )  I  PR  I N T  =  1 
300  CONTINUE 

IF( IPRINT. NE.O)  vyRITE{6.202)  I Y . Y ( 1 Y ) . ZGEO ( I Y ) , SHP (I Y ) , SHM ( I Y ) . 

1  TOTH, SCAPHPC IV) ,SCAPHM(IY) .DP.DM.RM 

100  continue 
C 

RETURN 

C 

200  FORMAT ( IHl .// ■  IRRAOIANCE  QUANTITIES  COMPUTED  FROM  THE  L  =  0  AMPLI 

ITUOES'//'  IV  V  ZGEO- ,4X. • scalar  h ( + ) ' . 4X , • SC A l AR  H(-)'. 

2  6X,  -SCALAR  H  .TX,  CAP  H  (  *  )  -  ,  7X. .  -  CAP  H( -)'.  5K  ,- 0  (-»)',  5X  .- D  {-)-,  BX  , 
1  -R(-)  '  /  ) 

201  FORMAT( -  ONLY  THE  DIFFUSE  AMPLITUDES  ARE  USED  FOR  X . L E . V . L E . Z ' ) 

202  FORMAT) 15 . 2F7 . 2 . 1P5E 15 . 4 . 0P2F9. 4 . IPE 15 , 4) 

203  FORMATt  lOX,  -A  A -  ,  IX ,  1 P5E 15 . 4 . OP 2F9 . 4 .  1  PE  15 . 4 / ) 

C 

END 
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SUBROUTINE  KFCNC I PKFCN . I VnFCN) 

ON  NHM5/KFCN 

THIS  routine  computes  THE  K-FUNCTIONS  ASSOCIATED  WITH  THE  SCALAR 
AND  PLANE  IRRAOIANCES.  THE  FUNCTIONS  ARE  COMPUTED  AS  RATES 
OF  CHANGE  WITH  RESPECT  TO  BOTH  OPTICAL  AND  GEOMETRICAL  DEPTH. 

SEE  8 . 12  and  B .  13 . 

WARNING:  EACH  PAIR  OF  DEPTHS  Y(Iv)  AND  V(IV»1)  IS  USED  TO  ESTIMATE 

the  KS  at  The  MIDPOINT,  BUT  THESE  ESTIMATES  MAY  BE  QUITE 
INACCURATE  IF  THE  Y'S  ARE  NOT  CLOSELY  SPACED. 

PARAMETER (MXMU= 10 ,  MXPhI=24,  MXY=30) 

C 

DIMENSION  IYKFCN(MXV) 

C 

COMMON/CGRID/  FMU(MXMU) , PMl CMXPH! ) . v(mxv ) .BNOMU(MXMU) . 

1  BNDPHI (MXPHl ) ,OMEGA(MXMU) . DELTMU (MXMU ) .ZGEO(MXY) 

COMMON/ C I RRAO/  HP ( 0 : MX V ) , HM ( 0 : MX Y ) . CAPHPfO :MXY ) . CAPMM ( 0 : MX Y ) 

C 

WRITE(6,30Q) 

C 

DO  100  IIY=1.IPKFCN 
lY  =  lYKFCN(IlY) 

C  ^  -2./(Y(lYfn  -  Y(tY)) 

YMID  =  0.5«(Y(IV»1)  +  Y(1Y)) 

AKP  =  C*fHP(IY»l)  -  HP(IY)  )/ (HP(  I  Y»  1)  HP(IY)) 

AXM  =  C»(HM(IY-<-l)  -  HM(  I  Y)  )  /  (HM(  I  Yf  1  )  »  HM  (  1  Y  )  ) 

CAPKP  =  C»(CAPHP(  IY«-1)  -  CAPhP(  I  Y  )  )  /  (  CAPHP(  I  Y»  1  )  ♦  CAPHPlIY)) 

CAPKM  =  C*(CAPhM(  IY-i-1)  -  CAPhM(  1  Y  )  )  /  (  CAPHM(  I  Y-f  1  )  ♦  CAPHM(IY)) 

100  WRITE(6,302)  Y (  I Y )  , Y ( 1 Y*  1  )  , YM 1 D , AxP , AKM . C APKP . C A PKM 
C 

WRITE(6,400) 

(. 

DO  500  I  I  V=:  1  ,  I  PKFCN 
I Y  =  1YKFCN(  I  IV) 

C  =  -2. / ( ZG£0(  I  V  - 1  )  -  ZGEOIIY)) 

ZMID  =  U  .  5*  (  ZGEOl  I  v«- 1  )  ZGEOIIV)) 

AKP  =  C*(HP(  I  V->- 1  )  -  mP(  I  V)  )  /  (hP(  I  V- 1  )  +  hP(IY)) 

AKM  =  C»(HM(IY'>'1)  -  HM(  I  y  )  )  /  (HM(  I  Y  t  1  )  -r  HM{IY)) 

CAPKP  =  C* ( CAPHPf  I V+ 1  )  -  CAPHPl  I  V ) ) / ( lAPHP( I Y+ 1  )  +  CAPHP(IY)) 

CAPKM  -  C*(CAPMM(ly^l)  CAPhM( Iy) )/(CAPHM(IV»1)  »  CAPHM(Iy)) 

600  wRir£(6,302)  ZGE0( IV ), ZGEOI I V+ n , ZMI D. AKP. AKM, CAPKP. CAPKM 
RETURN 
C 

300  FORMAT!  IMl  .//  ■  OPTICAL  DEPTH  K  FUNCTIONS  ( NOND I  MENS  I ONA L )  FOR  IRRA 
IDIANCES  (VALID  ONLY  WHEN  YuPPER  AND  VlOWER  ARE  CLOSELY  SPACED)’// 

2’  YuPPER  VC  OwER  ,  7X  .  '  V  ■  .  7.'' . 

3■K(•^)  K(-(  CAP  K(»)  CAP  K(-)-/) 

302  FORMAT C 3F 10 , 3 . 4F  10 . 5  ) 

400  FORMATC///'  GEOMETRIC  DEPTH  K-FUNCTIONS  (UNITS  OF  1/METER)  FOR  IRR 

iauiances  (valIC  only  when  zupper  and  zlOwer  are  Closely  spaced)'// 

2  ZUPPER  C..0WER  .6X.  'ZGEO'  .5X. 

3’K(t)  K(-i  CAP  kC-')  cap  K(-)  /) 

END 
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Subroutine  krad( ipkfcn, ivkfcn) 

ON  NHM5/KRAD 

THIS  routine  computes  the  K-FUNCTIONS  for  RADIANCES.  USING  8 , 26B . 

FOR  A  SELECTED  SET  OF  DIRECTIONS.  TmE  FUNCTIONS  ARE  COMPUTED  AS 
RATES  OF  CHANGE  WITH  RESPECT  TO  BOTH  OPTICAL  AND  GEOMETRIC  DEPTHS. 

THE  PATH  FUNCTION  IS  ALSO  COMPUTED.  USING  2.2  AND  THE  SAME  DEPTH 

DERIVATIVES . 

WARNING:  A  SELECTED  PAIR  OF  DEPTHS  V(IV)  AND  V(IY»1)  IS  USED  TO 

ESTIMATE  DERIVATIVES  OF  THE  RADIANCE  AT  THE  MIDPOINT.  BUT 
THESE  ESTIMATES  MAY  BE  QUITE  INACCURATE  IF  THE  V  LEVELS  ARE 
NOT  CLOSELY  SPACED  (E.G.  0.01  OPTICAL  DEPTHS  APART) 

PARAMETER(MXMU= 10 ,  MXPHI=24.  MXY=3u.  MXS1GY=3) 

DIMENSION  lYKFCN(MXY) 

COMMON/CGRID/  FMUlMXMU ) . PHI ( MXPHI ) . Y ( MX V ) . BNDMU(MXMU) . 

1  BNOPHI (MXPHI ) .OMEGA(MXMU) , DELTMu ( MXMU ) .ZGEO(MXY) 

COMMON/ CSI GY/  YSIG(MXSIGY) . ALBESS ( MXSI GY )  . TOTALS (MX SI  GY ) 

COMMON /CR AO  I F /  RADAP ( MXMU . MXPHI )  . RADP(MXMU .MXPHI  . MXY )  . 

1  R ADAM (MXMU .MXPHI ) . R A DM (MXMU .MXPHI , MXY ) 

COMMON/CRAOIR/  R ADQAP ( MXMU . MXPH I ) . RADOAM ( MXMU . MXPHI ) . 

1  RADOM(MXMU. MXPHI .MXY) 

COMMON/CKRAD/  I  START ,  I  STOP .  I  STEP . JST ART , JSTOP . JSTEP 
COMMON /CMI SC/  IMISC(20) .FMISC(20) 

NMU  =  IMISC(  1) 

NSIGY  =  IMISC(5) 

RAOEG  =  FMISCO) 

WRIT£(6.300) 

LINE  =  5 

DO  200  J=JSTART. JSTOP. JSTEP 
PHIOEG  =  RAOEG»PHI(J) 

non-polar  Quads 
DO  200  I  =  ISTaRT  .  ISTOP, ISTEP 
THEDEG  =  RADEG*ACOS(FMU( I ) ) 

WRITE(6.301) 

LINE  =  LINE  +  1 

DO  200  IIY=1. IPKFCN 
lY  =  IYKFCN( I lY) 

C  =  1.0/(Y(IV<-li  -  V(IY)) 

YMID  =  0,5»(Y(IY+1)  +  Y(IY)) 

0  =  (V(IY+1)  -  V{ I  V )  ) / ( ZGEO( I V+ 1 )  -  ZGEOIIY)) 

ZMID  =  0 . 5* ( ZGEO( I Y+ 1 )  f  ZGEO(lY)) 

GET  RADIANCES.  RADIANCE  DERIVATIVES.  AND  ATTENUATION  FUNCTION 
AT  YMIO 

RPMID  =  0 . 5*  (  RADP(  I  .  J  .  I  V<- 1  )  ♦  RADP(  I  .  J  ,  I  V  1  ) 

RMMIO  =  0 . 5*  (RADM(  I  .  J  ,  I  V+ 1  )  RA0M(I,J.IY)  ♦  R  ADOM  (  I  .  J  ,  I  Y+ 1 )  + 

1  RAD0M(  I  . J  ,  I Y  )  ) 

C 

DNPDY  -  C*  (RADPI  I  .  J  ,  I  Y-f  n  -  R  AOP  (  I  ,  j  ,  I  Y  )  ) 

DNMDV  =  C*  (RADM(  I  ,  J  .  I  V+ 1  )  -  RAOMd.J.IV)  R  ADOM  (  I  ,  J  ,  I  V  »  1  )  - 

1  RAOOM( I  , J .  I  V  )  i 

C 

I F ( NSIGY . EO .  1  .OR.  YM I D . L E . Y S I G i  1 )  )  THEN 
ALPHA  =  TOTAlSI  1 ) /AlBESS(  1) 

ElSEI F ( YM ID. GE.ySIG( NSIGY))  THEN 
ALPHA  =  TOTAlS(NSIGY)/AlBESS(NS1GY) 

ELSE 

DO  55  JV=2. NSIGY 
1 F { VMI D . LT . YSIG( JY ) )  GO  TO  55 

55  CONTINUE 

56  DY  =  (YMID  -  YSIG( JY- 1 ) ) / ( YSIG( JY)  -  YSIG(JY-I)) 

ALPHA  =  (1.0  -  DY ) *T0TALS( JY-l ) /ALBESS( JY- 1  )  ♦ 

1  DY* TOTALS! JY ) /AlBESSI JY  ) 

ENOIF 
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C  the  path  function  at  VMID,  using  2.i 

PATHFP  =  -FMU(  I  )  •ALPHA*DNPOV  +  AlPi-iA  »RPMI  D 
PATHFM  =  -FMU( I ) ‘ALPHA^ONMOV  +  AlPHA*RMM1D 

C 

C  the  K-FUNCTIONS  at  VMID,  USING  8.268 

FKP  =  -DNPDV/RPMID 
FKM  =  -DNMDV/fiMMIO 

C 

WRI TE (6 , 302)  I  . J , THEDEG. PHI  DEG. v( 1Y).V(1V-H),VMID.RPMID, RMMID , 

1  pathfp,pathfm,fkp,fkm.zmid.o*fkp.o«fkm 
line  =  LINE  +  1 
if(line.gt.58)  then 
WRITE(6,300) 

LINE  =  5 
ENOIF 

200  CONTINUE 
C 

L  PO'  AR  CAP 

C 

WRITE(6,301) 
line  =  LINE  +  1 
DO  100  nY=l.IPKfCN 
IV  -  IVKFCN(IIV) 

C  =  1.0/(V(IV»1)  -  V(IV)) 

VMID  =  0 . 5»  (  V  (  I  V->  1  )  >  V  (  I  V  )  ) 

D  =  (VlIV+l)  -  y (  I  V )  ) / ( ZGEO ( 1 y *  1  )  -  ZuEO(IV)) 

ZMID  =  0.5*(ZGe0(  IV+n  ZGEOIIV)) 

GET  RADIANCES.  RADIANCE  DERIVATIVES.  AND  ATTENUATION  FUNCTION 
at  VMID 

RPMID  =  0 . 5* ( R AOP ( NMU ,  1  .  I V»  1  )  »  R AUP ( NMU .  1  .  I  V )  ) 

RMMID  =  0 , 5*  {  RAUM  (  NMu  .  1  .  I  v-f  1  )  »  RADMI  NMU  .  1  .  I  V  )  ♦  R  ADOM  (  NMU  ,  1  ,  1  V  ♦  1  ) 

1  +  RAD0M(NMU , 1 , ! Y ) ) 

C 

DNPDV  =  C* ( RA0P( NMU ,  1 ,  I  V* I )  '  RADP( NMU .  1  .  1 V ) > 

ONMDV  =  C* ( RA0M( NMU .  1 ,  I y ♦  I  )  -  RADM ( NMU .  1 .  I  V )  »  R ADUM ( NMU ,  1 ,  1 V*  1 )  ' 

1  RAD0M( NMU , 1 . I y ) ) 

C 

I F ( NS  I GV . EQ .  1  UR.  YMI D . LE . ySlGl  1  )  )  iHbN 
ALPHA  ^  TOTALS!  1  ) /AlBESS(  1) 

ELSEIF(yMID,GE,ySIG(NSlGV))  THEN 
alpha  =  TOTALS(r)'iIGY)/AL0ESS(NSIGV) 

Else 

DO  57  JY=2,NSIGV 

IF ( VMI 0. LT . ySIG( JV) )  GO  TO  58 

57  CONTINUE 

58  Dv  =  (YMiu  -  ysiG( jy-1) )/(ysiG( jy)  -  ySiG(jy-i)) 

ALPHA  =  (1.0  -  DV ) ‘TOTALS! JY- 1 ) /AL 6ESS( JV -  1 )  + 

1  Dy‘TOTALS( jv J / AL0ESS(  jy ) 

ENDI  F 
C 

c  The  path  functii’.n  at  ymid.  using  2.2 

PAThFP  =  - FMU ( 1 ) ‘ALPHA ‘DNPUy  +  AlPHA»RPM1D 

PATHFM  =  -FMU  (  I  )  *  ALPHA‘DNMDY  •»  ALPhA‘RMMIO 

c 

c  The  k  Function^  at  ymid.  usinl.  8.200 

FKP  -  -DNPDy/RP^'I  D 

fkm  -  -onmoy/rmmid 

c 

I  :  NMU 

J  ^  II 

ImEJLG  =  u. 

PH  1  deg  -  0. 

WRnElb,30  2)  i  . j.lHEDEG.  PH  IUEG.Y(ly),y(IY->-l),  YMID, RPMID,  RMMID  , 

;  PAThFP,PAThFM,FKP,FKM,ZMID,D‘FkP,D‘FKM 
line  =  line  ■»  I 
I  F ( I  I NE . GT . 56 )  Then 
WRI TE(6, 300) 
line  =  5 

ENOIF 

lOU  continue 

RETURN 

C 
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300  FORMAT ( IMl .// -  RADIANCES.  PATH  FUNCTIONS,  AND  RADIANCE  K-FUNCTIONS 
1  FOR  SELECTED  DIRECTIONS  (VALID  ONLV  WHEN  VUPPER  AND  VLOWER  ARE  CL 
20SELV  SPACED) ' //T90 ,• NONDIMENSIONAL 1 IX. • dimensional  (1/M)'/ 

3'  I  J  THETA  PHI  VUPPER  VLOWER  V  RAD+ ( V ) ' , 

4  4X.'RAD-(V)  PATHF-'-CV)  PATHF*(V)  K  (  <■  )  K  (  -  )  '  .  6X  . 

5  ZGEO  K(*)  K(-)) 

301  FORMATdH  ) 

302  FORMAT (2I3.F6.1.F7.1.2F7.3,F8.4.1P4£11.3.0P2F9.4,F9.3.2F9.4) 

END 


subroutine  PRINT! IPRAD, IVPRAD) 

ON  NHM5/PRINT 

this  routine  prints  out  the  final  radiance  fields  at  selected  y  levels 

PARAM£TER(MXMU=10,  MXPHI=24.  MXV=30) 
dimension  IVPRAO(MXV) 

COMMON/CRAOIF/  RAOAPCMXMU.MXPHI ) . RADP{ MXMU , MXPHI .MXY) . 

1  RADAMCMXMU .MXPHI ) . RAOM( MXMU , MXPHI ,MXV) 

COMMON/CRADIR/  RAOOA P ( MXMU . MXPHI ) , RADOAM ( MXMU . MXPH I ) , 

1  RADOM(MXMU .MXPHI .MXV) 

COMMON /CGR ID/  FMU(MXMU) .PHI (MXPHI ) ,V(MXV) .BNDMU(MXMU) , 

1  BNDPHI (MXPHI ) ,0MEGA(MXMU) . DELTMU ( MXMU ) . ZGEO(MXV) 

COMMON /CPR AO/  I  PR ADI . I PRA02. IPRAD3 . JPRADl , JPRAD2 , JPRAD3 
COMMON/ CMI SC/  I  MI  SC ( 20) . FM I  SCI  20) 

COMMON/CWORK/  ThEDEG(MXMU) . PHIDEG(MXPHI ) 

NMU  =  IMI SCI  1 ) 

NPHI  =  IMISC(2) 

RADEG  =  FMISCf3) 

CONVERT  MU  AND  PHI  TO  DEGREES 

DO  50  1=1. NMU 

50  THEOEGtl)  =  R A DEG • A COS ( FMU ( I ) ) 

DO  51  J=1,NPHI 

51  PMIDEGIJ)  =  RAD£G*PMI(J) 

C  WRITE  RADIANCES  AT  V  =  A 

C 

WRIT£(6,300) 

DO  302  I=IPRAD1 , IPRAD2. IPRAD3 
WRI TE( 6 ,  102 ) 

DO  302  J= JPRAD 1 . JPR ADZ , JPRAD3 

30  2  WR I TE ( 6 , 304 )  I  . J , THEO£G( I )  . PH I  DEG (  J )  . RAOAP(  I  , J )  , RAD0AP(  I  , J )  . 

1  RAD0AM( I , J ) 

WRITE(6. 102) 

I  =NMU 
J  =  1 

WRI TE( 6 . 304 )  I , J , THEDEG( I ) . PHIOEG( J ) . RADAP( I , J ) , RAD0AP( I , J ) , 

1  RADOAM! I . J ) 
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WRITE  RADIANCES  AT  Y  =  A . Z 

WRITE(6, 100) 

DO  101  IVV=1.IPRAD 
lY  =  lYPRAD(IYY) 

WRITE(6, 110) 

DO  103  I =IPRA01 . I PRA02 , I PRA03 
WRITEle.  102) 

DO  103  J=JPRAD1 . JPRAD2 , JPRA03 

103  WRITEle. 104) I . J , I Y ,TmEOEG( 1 ) . PMIOEGIJ)  . Y( I Y)  . ZGEO( I  V)  , 

1  RADP( I . J , I  V) , RADM( I  , J , I Y) , RADOMI I  . J . 1 V) 

wRlTECe.  102) 

I  =  NMU 
J  =  1 

WRITE (6,  104)  I  , J , I  V, THEDEGI 1 )  .PHIDEGI J)  . V( I Y)  , ZGEO( I  V)  , 

1  RADP( 1,J,IY),RADM(I,J.IY) .RADOMi I . J , 1 Y) 

101  CONTINUE 

RETURN 

100  FQRMAT(1H1,-  the  FINAL  DIFFUSE  AND  DIRECT  RADIANCES  AT  INTERIOR  Y 
lYALUES  ARE ' / ) 

102  FORMATt IM  ) 

104  FORMAT! 314 ,2F9.3.2F8.3.1P3E16.5) 

110  F0RMAT(1h0,-  I  J  K 4X theta •. 4A PHI •. 7X Y  ZGEO ' . 6X , 

1  7HRA0« ( + ) ,8X . 7HRAO* ( - ) ,ax . 7hRADO( -) ) 

300  F0RMAT(1H1,'  the  final  diffuse  and  direct  radiances  at  Y  =  a  ARE'/ 

1/'  1  J  '  ,  4X  .  •  ThETA  •  ,  4X  ,  '  PHI  •  .8X.  7HRAD*  (  •■  )  .  8X  .  7hRAD0(  ♦  )  ,  BX  . 

2  7HRAD0(-)) 

304  FORMAT(2I4.2F9.3,  1P3E15.5) 

END 
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subroutine  RADY{ I PIRAD , I VIRAD) 

ON  NHM5/RADV 

THIS  routine  PRINTS  SELECTED  RADIANCES  (UP,  DOWN.  AND  HORIZONTAL 
ALONG-WIND  AND  CROSS-WIND).  RADI ANCE - I RRAD I  ANCE  RATIOS  ARE  ALSO 
COMPUTED. 

PARAMETER(MXMU=10.  MXPHI=24,  MX¥=30) 

DIMENSION  IVIRAD(MXV) 

COMMON/CRADIF/  R ADAP ( MXMU . MXPHI ) , R ADP ( MXMU , MXPHI ,MXV) , 

1  RADAM(MXMU .MXPHI ) . RADM (MXMU , MXPHI .MXV) 

COMMON/CRADIR/  RADOAP { MXMU . MXPHI ) . RADOAM ( MXMU , MXPHI ) , 

1  RADOMCMXMU. MXPHI .MXV) 

COMMON/ CGR ID/  FMU(MXMU) . PHI (MXPHI ) . Y(MXV ) . BNDMU(MXMU) . 

1  6NDPHI (MXPHI ) .OMEGA(MXMU) . DELTMU(MXMU ) .ZGEO(MXY) 

COMMON/ Cl RRAD/  SHP(0 :MXY) , ShM(0 :MXY ) . SC A PhP ( 0 ; MX Y ) . SC A PHM ( 0 : MXV ) 
COMMON/CMISC/  IMISC(20) 

NMU  =  IMl SC(  1  ) 

NPHI  =  IMISC(2) 

Y  =  A 

RAOUP  =  RA00AP(NMU  .  1  )  ->■  RADAP(NMU.l) 

RADON  =  RAD0AM(NMU, 1)  ♦  RA0AM(NMU,1) 

RHQ  =  0 . 5»  (RADOAP(  1  ,  1 )  f  RADAP(l.I)  RADOAM(l.l)  +  RADAM(l.l)) 

J90  =  NPHI/4  <■  1 

RH90  =  0 . 5»  (RAD0AP(  1  .  J90)  +  RADAP(1,J90)  R  ADOAM  (  1  .  J90  )  + 

1  RADAM(  1 .090)  ) 

Jiao  =  NPHI/2  ♦  1 

RH180  =  0.5*(RAD0AP( 1,0180)  ♦  RADAP(  1  , J  180  )  »  R ADO AM (  1  .  0  1 80 )  » 

1  RA0AM(  1,0180)  ) 

RN  =  RAOUP/SCAPHM(0) 

QM  =  SCAPHP(0)/RA0UP 
WRITE(6,  lOO) 

WRITE (6, 102)  RADUP.RADDN.RHO.RHyU.KHlBO.RN.QM 

depths  X  .LE.  y  .i-£.  Z 

DO  200  I  1 Y=  1  . I PIRAD 
IV  =  IYIRA0(  I  lY  ) 

RADUP  =  RAOP(NMU ,  1 ,  I  V ) 

RADON  =  RADOMt  NMU  ,  I  .  I  Y  )  RADM (  NMU  .  1  ,  I  Y  ) 

RHO  =  0 . 5» (RAOP(  I ,  1 .  I  V )  »  RAD0M(  1 .  1  . lY)  ♦  R ADM ( 1 .  1  .  I Y )  ) 

RH90  =  0 . 5*  (  RAOP(  1  .  J90  .  I  Y  )  R  AOOM  (  I  ,  J90  ,  I  V  )  ♦  R  ADM  (  1  .  J90  ,  I  Y  )  ) 

RH180  =  0 . 5»  (  RADP(  1 , 0180 . 1  V  )  RAD0M(  1 . 0  180  .  I  Y  )  +  R ADM (  1  .  0  1 80  ,  I Y  )  ) 

RN  =  RADuP/ SCAPhM ( I Y  ) 

QM  =  SCAPHP(  I  V ) /RADUP 

200  WRITE(6,104)  IV,y(lY). ZGE0( Iv) .RADUP. RADON. RHO . RH90 . RH180 . RN , QM 
C 

RETURN 

C 

100  FORMAT!////'  SELECTED  RADIANCES  AND  RAD  I ANCE - I RRAD I ANCE  RATIOS'// 
1'  IV  V  ZGEO  N-f(Y.M..)  N-(Y.M,.)  NH  ( Y  ,  0 )  '  . 

27X  .  '  NH(  Y  ,  90  )  NH(Y.180)  RN(Y.-)  Q  (■►)'/ ) 

102  FORMAT ( lOX ,' A  A  '.1P7E16.4/) 

104  FORMAT ( 15 , 2F7 . 2 , 1P7E 15 . 4 ) 

END 
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c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


C  -H-  -f  + 

c 

c 

c 

c 


c 


c 


L 


subroutine  RT (  1 RTElk  .  I >R 'l  ) 

ON  NHMS/RTECX. 

THIS  routine  Checks  the  final  TuIAi  radiances  by  seeing  if  they 
satisfy  the  OuAD- averaged  RADIAMvE  transfer  equation  3.12  AT 
interior  y  values,  x.lt.y.lt.z 

irteck.lt.o  if  the  balance  of  The  rte  is  to  be  computed  at  all 

possible  interior  y  levels.  Y(2J .  V(NY-l) 

IRTECK.EQ.O  IF  NO  RTE  BALANCE  CnECh  IS  TO  BE  MADE 

irteck.gt.o  if  The  rte  balance  is  lumputed  Ai  The  y  levels  given  by 
y(lY«TE(l)) . V( iyrtei IRTECK) ) 

NIC,  NJC...ARE  USED  TO  SELECT  PARTICULAR  MU  AND  PHI  VALUES 

where  The  rte  balance  LhELk  is  to  be  made,  if  IRTECK.NE.O 
MU(I)  and  PhI(J)  are  checked,  where 

DO  J=  1  , NPhI . n jc 
DO  I = 1 . 2*NMU . N I C 

AND  VufI)  IS  IN  Kl(-)  IF  I.lE.NMU 

MU(  I  )  IS  In  Xll»)  IF  I.GT.NMu  .AND.  1.1.  E.2*NMU 

WARNING:  DN/Dv  IS  COMPUTED  USINu  A  lENTERED  DIFFERENCE.  IF  THE  Y 

values  are  not  EyEnly  SPACED  OR  IF  Tr-iEY  ARE  FAR  APART.  THIS 
estimate  of  The  derivative  MAY  BE  QUITE  INACCURATE,  CAUSING  A  POOR 
balance  of  the  R  ■' £  EvEN  ThOuGh  T  h£  (atMPuTED  RAOIANCES  ARfc  CORRECT. 

PAR  AME  TER  (  MXMU- 10  ,  MKPHI=2A.  M.yV  =  ;j(),  MXSIGY  =  3) 

PARAMETER  (  MX L  -  MX PhI  /  2  .  MXGEOP -Mxlviu ♦  (  MXL»  1  )  ) 

COMMON /CHAD  I F /  R ADAP( MxMU .MXPhI  )  . RAUP (MXMU , MXPHl  . MXY )  , 

1  RADAM ( MXMU , MXPhI ) , R ADM ( MXMU . MXPH I ,MXY) 

common/ CR AO  I R !  R ADO AP( MXMU .MX PH I  )  , R ADO AM (MXMU .MXPHI  )  . 

I  RAOOMI MXMU , MxPhI ,MXY ) 

COMMON/ CGR I D/  FMU  C  MxMU )  .PHI TMxPnl  )  . V ( MXV ) 

common /CGEOP/  utUPPlMXMU.MXGEuP.WxSlviv ) .GEOPMIMXMU.MXuEOP.MXSiGY) 
common /CS IGY/  r  S  r  G( MXSI Gy ) , Al  BE  SS ( MXS I  GY ) 

COMMON /CM  ISC/  I  MI  SC  (  20  I  ,  FM!  Si.  (  2U  ) 

common  /  C  WORK/  ..Lf'PPv  (MXMU  .  M.x  GE  C)P  i  .  uM.T'MY  (  MxMU  .  MXGEOP  ) 

OIMENilON  IYRTEIMXY) 

NMu  =  IMI  SC  (  1  .1 
NPHI  =  IMI SC (  2  ) 

NY  =  IMISC(A) 

Ns  I  GY  =  IMI  ST.  IS) 

N  R  M  A  T  L  I  M  I  S  C  (  I  C,  ) 

NIL  =  IMI  SC (  Is  ) 

N  j  L  =  I M I  S  C  <  1  e  . 

NMo'2  -  NMu  *2 
NOP  I  =  nPh I / 2 
I  F  (  I  RTECK  ,  lT  .  ,  Then 

I yMI N  =  2 
I  yMAX  =  NY  -  I 

Ei.SE  I  F  (  I  kTECk  -.X  ,  l  I  ''hEN 

lYMIN  -  1 

IVMAx  =  IRTFi- 

El  Lt 

RE  T  ,jRN 

E  N  D  I  F 

WR  I  '  t  I  O  .  2U'J  ) 

j,  ■.  ABLl  I  Ht  .  R"!.  FS'./  Y  vALUES  FUR  WHil.H  Th£  RTE 

IS  t  ,  A  L  A  r  e 

!  ,  ,J  I  L.  ‘OR  ALU  RiUIFNL 

Il.lT.U  fur  LLjXNWARu  RAUIAf^uL 


DU  300  I I YM; N , I VMA> 
I  YL  -  ;  YRTLl  I  Y  , 

V  N  0  w  =  V  (  I  V  L  ; 
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c  define  the  albedo  and  phase  Function  at  the  needed  v  value  bv 

C  LINEAR  INTERPOLATION  OF  THE  KNOWN  VALUES 

C 

IFINSIGV.EQ. 1  .OR.  VNOW. LE . YS1G( 1) )  THEN 
albedo  =  ALBESS(I) 

DO  50  J=l,NRHAT 
DO  50  I=l,NMU 

GEOPPVd.J)  =  GEOPPd.J.l) 

50  GEOPMYCI.J)  =  GEOPMd.J.l) 

C 

ElSEIF(VNOW.GE.YSIG(NSIGY))  then 
albedo  =  ALBESS(NSIGY) 

DO  52  J=1,NRHAT 
DO  52  1=1, NMU 

GEOPPVd.J)  =  GEOPPd  ,  J  .NSIGV  ) 

5^  GEOPMYd.J)  =  GEOPMCI  ,  J  .NSIGY) 

C 

else 

do  55  JY=2. NSIGY 
I F ( YNOW . LT . YSIG( JY ) )  GO  TO  56 

55  CONTINUE 

56  DY  =  (YNOW  -  YSIGIJY-I ) ) / ( YSIG{ JV )  -  YSIGIJY-D) 

C 

ALBEDO  =  (1.0  -  OY)  *Al6ESS(  JV- 1  )  -<■  D  V  *  A  LBE  SS  (  J  Y  ) 

DO  58  J=1,NRHAT 
DO  58  1=1, NMU 

GEOPPVd.J)  -  (1.0  -  OY)  *GEOPP(  I  .  J  .  JV- 1 )  DV»GEOPPd  .  J  .  JV  ) 

58  GEOPMY(I.J)  =  (1.0  -  DY)  *GEOPM(  1  .  J  .  JV- 1 )  DY  »  GEOPM  (I  .  J  .  J  Y  ) 

ENOI  F 
C 

DO  300  JC=  1  .  NPMI  . N jC 
DO  300  IC2=1,NMU2.NIC 
IFdC2  .  LE  .  NMU  )  then 
IC  =  -IC2 

ELSEI F (I C2 . GT . NMU  .AND.  1C2.lE.NMU2)  THEN 

IC  =  IC2  -  NMU 

ELSE 

C  IC  =  0  NOT  VALID 

GO  TO  300 
ENOIF 

ICA  =  lABSi IL ) 

IFdCA.EO.NMU  .AND.  JC.NE.I)  GO  TO  300 
IF(IC.GT,0)  then 
FMUIC  =  FMUCICA) 

ELSE 

FMUIC  =  -FMU(ICA) 

ENOIF 

EVALUATE  THE  TERMS  OF  THE  RTE 

TERMl  -  MU»DN/DV 
C 

IFdC.GT.O)  then 

TERMl  =  RADP(  I CA  ,  JC  .  I YC»  1  )  '  R A DP (  I C A , jC ,  I  VC  -  1  ) 

else 

TE.RMl  -  RADMI  I  CA  .  JC  .  I  VC+ 1  )  '  R  ADM  (  I  C  A  .  jC  .  I  YC  -  1  )  + 

1  RAOOM(  1  CA  .  jC  .  I  YC*^  1  )  -  RAOOMdCA  ,  JC  .  I  YC- 1  ) 

ENDI  F 

TERMl  =  FMUI  C  •  TERM  1  /  (  V  (  I  VO  1  )  -  v  |  I  vC  .  1  )  ) 

L 

C  TeRM2  =  -  N 

C 

I  F (  I  C . GT . 0 )  T  mFn 

rERM2  -  -RADF ( ! LA . jC . 1 YC ) 

ElSE 

TERM2  =  -RADM ( I CA . jC . I YC )  "  RADUM( I CA , jC . I VC ) 

ENDI  F 
C 


130 


ooo  nnn  noo  nnno 


§6.  PROGRAMS 


TERMS 


(ALBEDO  OF  SINGLE  SCATTERING) 
ALBEDO  ♦  PATH  FUNCTION 


♦  INTEGRAL  OF  (RADIANCE  • 

PHASE  FUNCTION) 


TERMS  =  0. 

DO  70Q  IR=1 ,NMU 
ISMAX  =  NPHI 
IF( IR.EQ.NMU)  ISMAX  =  1 
DO  700  1S=1. ISMAX 

RP  =  RADP( IR , I S , IVC) 

RM  =  RA0M( IR ,  I S ,  I  VC)  +  R ADUM ( I R .  I S .  I VC ) 

COMPUTE  storage  INDEX  FOR  GEOPP  AND  GEOPM 
IVS  =  lABS(jC-IS) 

IVINDX  =  IVS  +  1 

I F ( I  VS . GT . NDPI )  IVINOX  =  NOPI  •  I  -  MOD C I  VS . NOP I  ) 
KCOL  =  NMU*(IVlNOX  -  1)  -  ICA 

I F ( I CA . £0 . NMU )  KCOl  =  NMU 
I F ( IR . EQ . NMU)  KCOL  =  ICA 
PP  =  GEOPPV ( IR .KCOL ) 

PM  =  GEOPMV I IR , KCOl ) 

IF ( I C . GT . D)  Then 

TERMS  =  TERMS  KM»PM  t  RP‘PP 

ELSE 

TERMS  -  terms  *  KM'PP  RP’PM 
ENDIF 

700  continue 

TERMS  =  albedo* terms 


OUTPUT 

SUM  =  TERMl  K  TERMS  ♦  TERMS 

WRI TECe . 20  1)  I C , JC , I  VC . TERMl , TERMS , I ERM3 , SUM 
SOO  CONTINUE 

FORMATS 

200  F0RMAT(1H1,'  FI-.Ll  ChECK  ON  COMPUTED  TOTAL  RADIANCES:/ 

16X . ■ evaluat ION  :?  The  radiative  transfer  equation  for  selected  mu. 

2  PHl  AND  V  VA^UE:^  /// 

S'  Ml)  Phi  V  ■  .  5x  .  •  mu*Dn/ov  '  .  ax  .  -  N.bx.  +  1  nT  (  n  *  s  I GMA  )  /  A  , 

A  5X .  ■ =  ZERO  '  /  ) 

SUl  FORMA  V  I  3 15 .  IPAt lb . o ) 

RETURN 

end 
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subroutine  SVNRAD( amp . rad . IROW) 

ON  NHM5/SVNRAD 

THIS  routine  synthesizes  THE  RADIANCE  FIELD  R(MU,PHI)  (FOR  A 
GIVEN  V  VALUE)  USING  5.3  AND  5.4. 

PARAMETER(MXMU= 10 .  MXPHI=24) 

PARAMETER (MXL=MXPHI /2) 

DIMENSION  AMP( 1) .RADCIROW. 1) 

DIMENSION  COSLPCO :MXL .MXPHi ) . SINlPCO :MXL , MXPHI ) 

COMMON/CGRIO/  FMU(MXMU) .PHI (MXPHI ) 

COMMON/CMISC/  IMISC(20) 

DATA  KALL/0/ 

I F ( HALL . EQ . 0 )  then 

THE  FIRST  call  does  INITIALIZATION 

NMU  =  IMI SC ( 1 ) 

NPHI  =  IMISC(2) 

NL  =  IMISCO) 

NRHAT  =  IMISC{10) 

DO  50  L^O.NL 
do  50  J=1.NPHI 

COSlPIL.J)  =  COS(FlOAT{l)»Ph1 ( J) ) 

50  SINLP(L,J)  =  SIN(FL0AT(L)*PHI ( j)  ) 

KAlL  =  I 
ENOIF 

LOOP  OVER  Al.l  Mu  and  phi  VALUES 

DO  100  I^l.NMo-1 
DO  ino  J=1,NLhI 

Sum  over  l  values,  eo  5.j 


SUM  -  0. 

00  200  L=0,Nt 

20U  Sum  Sum  ♦  amp(  nmu*l»  i  »  •vOslP(  l  .  j  ) 

1  •  AMP ( NRmA T »NMU»L » 1 ) ‘ S I NL P l I . J ) 

100  RAO(  I  ,  J  )  =  SUV. 

POLAR  CAP  TLHM  0V  S.4 
RAD  (  NMU  ,  1  )  =  AMP  1  NMli  ) 

DO  102  J-2.NPHI 
102  RAD(NMu,j)  =  u. 

C 

RETURN 

END 
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7.  GRAPHICS  PROGRAMS 

The  running  of  the  Natural  Hydrosol  Model  is  completed  with  the  computations  of 
Program  5.  TAPE50,  written  by  Program  5,  contains  the  computed  radiances  and  other  informa¬ 
tion.  However,  the  most  convenient  form  for  the  output  is  often  graphical.  We  therefore  include 
in  this  report  a  few  programs  for  plotting  radiance  distributions,  chromaticity  diagrams,  and  the 
like. 

Each  of  the  listed  programs  uses  standard  CalComp  Basic  Software,  as  implemented  on  the 
author’s  CDC  Cyber  855  computer.  This  implementation  uses  both  TAPE98  and  TAPE99  in 
order  to  generate  output  files  for  both  videoterminal  and  hardcopy  plot  devices.  This  is  non¬ 
standard,  but  only  minor  rewriting  will  be  required  to  use  the  programs  on  other  computer 
systems. 

A.  Plotting  Radiance  Distributions 

Program  MPRAD  reads  the  radiance  data  from  TAPE50  and  plots  radiance  distributions, 
as  a  function  of  depth  and  direction,  on  a  variety  of  formats. 

1.  Input 

Each  plot  is  generated  by  two  to  four  free-format  records. 

Record  1:  ITYPE,  NTIT,  NYPLT 

ITYPE  specifies  the  type  of  plot  to  be  made,  as  described  in  record  2,  below. 

NTIT  <0  if  no  title  is  desired  at  the  top  of  the  plot 

>0  if  an  alphanumerical  title  for  the  top  of  the  plot  is  to  be  read  in  record 
la 

NYPLT  <0  if  all  y-levels  are  to  be  plotted 

>0  if  only  selected  y-levels,  NYPLT  in  number,  are  to  be  plotted,  as 

specified  in  record  lb 

Record  la:  ITITLE 

T+iis  record  is  read  only  if  ITIT  >  0.  ITITLE  is  an  alphanumeric  title  for  the  top  of  the  plot. 
Up  to  80  characters  are  allowed. 

Record  lb:  1YPLT(1),  -,1YPLT(NYPLT) 

This  record  is  read  only  if  NYPLT  >  0.  The  values  of  lYPLT  are  the  J  indices  of 
YOUT(J),  J  =  I,  -, NY  at  which  plots  are  to  be  made  (cf.  record  5  of  Program  4). 
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Record  2:  depends  on  ITYPE 

This  record  is  the  specification  record.  It  gives  the  values  of  the  parameters  needed  to 
specify  the  details  of  the  plot,  as  follows: 

If  ITYPE  =  1,  make  polar  plots  of  the  logarithm  of  the  diffuse  radiance  as  a  function 

of  6.  The  specification  record  gives  JPHI  and  JPI,  which  are  the 
(()-indices  of  o-'o  half-planes.  Normally  <))(JPI)  =  (t)(JPHI)  +  n,  so  that 
a  planar  cross  section  of  the  radiance  is  plotted. 

A  separate  plot  is  made  for  each  depth. 

If  ITYPE  =  2,  make  polar  plots  of  the  logarithm  of  the  total  radiance  as  a  function  of 
6.  Otherwise  as  for  ITYPE  =  1. 

If  ITYPE  =  3,  plot  the  logarithm  of  the  diffuse  radiance  as  a  function  of  0.  The 

specification  record  gives  JPHI  and  JPI  as  for  ITYPE  =  1. 

All  depths  are  on  the  same  plot. 

If  ITYPE  =  4,  plot  the  logarithm  of  the  total  radiance  as  a  function  of  0,  otherwise 
as  for  ITYPE  =  3. 

All  depths  are  on  the  same  plot. 

If  ITYPE  =  5,  make  a  polar  plot  of  the  diffuse  radiances  as  a  function  of  (|).  The 

specification  record  gives  ITHETA,  the  index  defining  a  particular 
0-cone; 

If  ITHETA  >  0,  upward  radiances  are  plotted 
If  ITHETA  <  0,  downward  radiances  are  plotted 
A  separate  plot  is  made  for  each  depth. 

If  ITYPE  =  6,  make  a  polar  plot  of  the  total  radiances  as  a  function  of  (]),  otherwise 
as  for  ITYPE  =  5. 

If  ITYPE  =  7,  plot  the  logarithm  of  the  diffuse  radiances  as  a  function  of  ({).  The 

specification  record  gives  ITHETA  as  for  ITYPE  =  5. 

All  depths  are  on  the  same  plot. 

If  ITYPE  =  8,  plot  the  logarithm  of  the  total  radiances  as  a  function  of  ()),  otherwise 
as  for  ITYPE  =  7. 

If  ITYPE  =  9,  plot  the  logarithm  of  the  total  path  function  as  a  function  of  0.  The 

specification  record  gives  JPHI  and  JPI  as  for  ITYPE  =  1 . 

All  depths  are  on  the  same  plot. 

Note;  ITYPE  =  5,  6,  or  9  cannot  be  used  in  the  listed  code,  since  the  required  subroutines 
PPHIPLR  and  PPATH  have  not  been  written  as  of  the  date  of  compilation  of  this  report. 
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2.  Code  Listing 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

(■ 


PROGRAM  MPRADtINPUT, OUTPUT , TAPEG^ IIIPuT .TAPEbiOuTPuT.TAPhGO, 

1  TAPEOa . TAPE99) 

ON  NHM6/MPRAD 

This  program  controls  the  plotting  of  the  radiances,  using  the 
FILE  of  radiance  DATA  WRITTEN  dv  PROGRAM  5  (TAPE50). 

ALL  Plotting  is  done  using  standard  calcomp  calls 

(TAPE98  AND  TAPE99  ARE  USED  9-  ThE  CAlCOMP  ROUTINES,  AS 
implemented  on  The  author  S  CDC  CYBER  855  COMPUTER.) 

EACH  PLOT  IS  GENERATED  BV  TwO  TO  FOUR  FREE-FORMAT  DATA  RECORDS. 

THE  FIRST  RECORD  GIVES  I  TYPE . NT  I T . NVPLT  WHERE 

ITYPE  SPECIFIES  THE  TYPE  OF  PLOT  TO  BE  MADE,  AS  DESCRIBED  BELOW. 
NTIT.lE.O  if  NO  title  for  the  top  of  the  Plot  IS  DESIRED 

.GT.O  IF  A  title  for  ThE  TOP  OF  ThE  PlOT  IS  TO  BE  READ  IN 
NVPLT. LE.O  IF  ALL  Y  LEvElS  ARE  TO  BE  PLOTTED 

.GT.O  IF  NYPLT  Y  LEVELS  ARE  TO  BE  PLOTTED 

IF  NTIT.GT.Q.  the  next  record  GlvES  THE  DESIRED  TITlE 

IF  NVPlT.GT.O,  ThE  NEXT  RECORD  alvES  THE  INDICES  OF  THE  V 
LEVELS  FOR  THE  PLOTS 

THE  last  record.  The  SPEC  I  F  K  A  '  I  .jN  RECORD.  GIVES  THE  VAIUES  OF 
The  PARAMETERS  NEEDED  10  SPECIFY  ThE  DETAILS  OF  THE  PlUT 

IF  ITVPE.EQ.l,  MAKE  POcAR  PcDTS  OF  Tut  I.OGARITHM  OF  THE  DIFFUSE 

radiance  as  a  Function  of  theta,  the  specification 
RECORD  GIVES  JPhI  AnD  jPI.  WHICH  ARE  THE 
Pnl  INDICES  OF  Iwo  hAlF-PLANES.  NORMALLY  PHl(jPI)  =■ 
PhKjPhI)  t  PI.  S.)  That  a  PlANAR  CROSS  section  of  the 
RADIANCE  IS  PnH  I  EL. 

A  SEPARATE  PlOT  IS  MADE  FOR  EACH  DEPTH. 


L 

L 

c 

C 

C 

c 

c 

(. 

c 

c 

c 

c 

c 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


IF  ITYPE, EO,  2,  make  polar  PlCT'^  OF  IhE  LOGARITHM  OF  THE  TOTAL 

RADIANCE  AS  A  Fut.CTION  OF  THETA.  0THERwI.'.,E  AS  FOR 
I  type  =  1  . 


IF  ITYPE. £0.3,  Plot  ThE  LOGARITHM  OF  THE  DIFFoSE  RADIANCE  AS  A  FONCTION  OF 
T>“ETA.  the  SPECIFICATION  RECORD  GIVES  jPHi  AND  JPI 
A  ^  FOR  ITYPE  =  1  . 

a^l.  depths  are  On  The  SAME  PLOT. 


IF  ITYPE. EQ. A,  PlOT  THE  LOGARITHM  OF  THE  TOTAL  RADIANCE  AS  A  FUNCTION  OF 
ThETA,  otherwise  A',  KyR  ITvPE  -  3. 
all  depths  are  (IN  The  SAME  PlOT  . 

IF  ITYPE. 60.5,  make  A  POLAR  PLOT  OF  ThE  DIFFUSE  RADIANCES  AS  A 
Function  of  phi.  the  specification  record  gives 

I  ThETA,  The  INDE-y  DEFINING  A  PARTICULAR  THETA  CONE: 

IF  IThETA.GT.u.  upward  radiances  are  PLOTTED 
IF  IThETA.lT.O.  DuwNwARU  radiances  ARE  PLOTTED 
A  separate  Plot  is  made  for  each  depth. 

IF  ITYPE.EQ.b.  make  a  polar  PluT  OF  TnE  TOTAL  RADIANCES  AS  A 
i^.iNCTlON  OF  PHI.  OTMEKV.ISE  AS  FOR  ITVPE  -  5. 


IF  ITYPE. ED. 7,  PluT  ThE  LOGARITHM  UF  THE  DIFFUSE  RADIANCES  AS  A 
-uNCTION  OF  Pr-I  The  SPEl  RFTC  GIvES  IThETA  as 
FuR  ITYPE  -  5. 

A;  depths  are  UN  TmF  same  PlOT, 


IF  ITvPE,EO,H.  .u.jT  The  lOuARITmM  of  t^e  loTAl.  RADIANlES  AS  A 
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FUNCTION  OF  PMl .  OTmENWISE  AS  FOR  ITVPE  -  7. 

IF  ITVPE. EQ. 9,  PLOT  THE  LOGARITHM  OF  THE  TOTAL  PATH  FUNCTION  AS  A 
FUNCTION  OF  THETA.  THE  SPEC  REC  GIVES  JPHI  AND 
JPI  AS  FOR  ITVPE  =  1. 

ALL  DEPTHS  ARE  ON  THE  SAME  PLOT. 

+  +  ♦■<■  WARNING:  ITVPE  =  5 .  6  OR  9  CANNOT  BE  USED.  SINCE  THE  REQUIRED 

subroutines  PPHIPLR  and  PPATH  HAVE  NOT  VET  BEEN  WRITTEN  (CM.  3  JUNE  88). 

PARAMETER(MXMU= 10 .  MXPHI=24.  MXV=30.  MXSIGV=3) 

PARAMETER(MXL=MXPHI /2.  MXGEOP=MXMu* ( MALf 1) ) 

COMMON/CSIGV/  VSIG(MXSIGV) . A LBESS ( MXS I GV ) . T OTALS ( MXS I GV ) 

COMMON VCGEOP/  GEOPP ( MXMU . MXGEOP . MXS I G V ) . G£OPM(MXMU . MXGEOP . MXSI  GV ) 

COMMON/ CGR ID/  THETA (MXMu) . PHI ( MXPHI ) . V ( MXV ) . BNDMU(MXMU ) . 

1  BNDPHI (MXPHI ) .OMEGA (MXMU) . DEL TMu ( MXMU ) . ZGE0(MXV ) 

COMMON/CRADIF/  R ADAP ( MXMU . MXPH I ) . R ADP I MXMU . MXPH I .MXV) . 

1  RADAM(MXMU. MXPHI ) , R ADM ( MXMU . MX Ph 1 .MXV) 

COMMON/CRADIR/  R ADO AP ( MxMu . MX pH I ) . R ADO AM ( MXMU . MXPH I ) . 

1  RADOM(MXMU .MXPHI .MXV ) 

COMMON /CM I  SC/  IMISC(20).FMISC(2U).nTIT,ITITl£(8) 

COMMON/CWORK/  WORK (5000) 

DIMENSION  FMU(MXMU ) . I VPlT (MXV ) 

DATA  NUlN/50/.  FPS/l.OE-10/ 

initialize  The  lalcomp  plotiinu  roui ines 
call  Plots 

READ  the  radiance  DATA  WRITTEN  Bv  PROGRAM  5 
REWIND  NUIN 

READ(NUIN)  IMISC.FMISC.FMu.PHI .V. BNOMU .BNDPHI .OMEGA , DEL TMU , 

1  VSIG.AlBESS. totals. ZGEO 

NMU  =  IMI SC( 1 ) 

NPHI  =  IMISC(2) 

NV  =  IMISC(4) 

NSIGV  =  IMISC(5) 
kCOl  -  IMISC( 10) 

RE AO (NUIN)  ( ( ( GEOPP( I . J .K ) . I ^ 1 . NMU ) . J=1 .KCOL) . K^l . NSIGV ) 

READ(NUIN)  (  (  (GEGPMC I  . J .K)  . I  =  1 . NMU )  . J=1 . KCOL )  . K=1 .NSIGV ) 

R£AD(NUIN)  ((RADAP(I.J).I=1. NMU) . J-1 .NPHI ) 

R£AD(NUIN)  (  (  I RADP( I  . J . K '  !  =  1 . NMU ). J= 1 . NPHI  ). K=  1  . NV  ) 

READ(NUIN)  ({RADAM(I.J).I=1 .NMU) . J= 1 . NPHI ) 

REAO(NUIN)  (((RA.TM(I.J,K).I  =  1.  NMU  ).J=l.NPHI).K=l.Ny) 

READ(NUIN)  ((RADCIAP(I,J).I  =  1  .  NMU  )  .  J  =  1  .NPHI  ) 

READ(NUIN)  ((RAU0AM(!.j),I  =  1. NMu  J  . J= 1 . NPHI  ) 

REAO(NUIN)  {((RAD0M(I.J,K).I=1. NMU ) .J=1.NPHI ) .K=l,NV) 

DIRECT  RADIANCES  WHICH  SHOULD  BE  ZERO  ARE  SOMETIMES  NEGATIVE 
DUE  TO  roundoff  ERROR;  RESET  TO  ZERO 
DO  60  K=1.NV 
DO  60  J^l.NPHl 
DO  60  1=1. NMU 

I F ( RAD0M( I , J . K ) . lT , EPS)  RADOM(l.j.x)  -  0. 

60  CONTINUE 

CONVERT  FMU  TO  tmETA 
DO  53  1=1. NMU 

53  ThETA(I)  =  ACOi(FMU(I)) 

READ  RECORDS  DESCRIBING  THE  PluIs 
THE  first  RECORD; 

100  READ( 5 . » . END  =  200)  I  TV PE . N VPLT . NT  I T 

THE  title  RECORD.  IF  REQUESTED 
I F(NTI T .GT . 0 )  Then 
READ(5.70)  ITITLE 
NTI T  =  NCHAR ( I T I TlE . B ) 

ENDI  F 
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IF(NVPLT.LE.O)  then 
DO  300  IY=1.NV 
300  IVPLT(IY)  =  lY 
ELSE 

C  THE  Y-INDEX  RECORD.  IF  REQUESTED 

READ(5.»)  {IYPlT(IY)  ,IY=1.NYPLT  ) 

ENDIF 

THE  specification  RECORD 

I F ( I  TYPE . GE .  I  .AND.  ITYPE.LE.4)  ThEn 
READ(5,*)  JPHI.JPI 

ElSEI F ( ITYPE . GE . 5  .AND.  ITYPE.LE.8)  THEN 
READ(5.*)  ITHETA 
ElSEIF (  I  type . EQ . 9)  then 
R£AD(5.»)  JPHI.JPI 
ENDIF 

CALL  THE  APPROPRIATE  PLOT  SUBROUTINE 

I F ( I  TYPE . EQ .  1  .OR.  ITYPE. EQ. 2)  IhEN 
call  PTHEPLRI ITYPE.NYPLT.IyPlT.jPHI .JPI ) 
ELSEIFI ITYPE.EQ.3  .or.  ITYpe.EQ.4)  ThEN 
CALL  PTMElOGI ITYPE . NYPLT . I YPlT . JPHl . JPI ) 
ElSEIF(ITYP£.EQ.5  .OR.  ITYPE. EQ. 6)  ThEN 
call  PPHIPLR 

ElSEI F ( ITYPE . EQ . 7  .OR.  ITYPE. EQ. 8)  THEN 
call  P PH I  log ( ITYPE.NYPlT.IYPlT.1 THEl A) 
ElSEIF ( I  TYPE . EQ . 9 )  THEN 
CALL  PPATH 
ENDIF 
GO  TO  lOQ 

200  call  plot ( 0 . . U . . -98 ) 

70  FORMAT(aAlO) 

END 


FUNCTION  NCHAR ( I TI TlE . NWORDS) 

GIVEN  AN  ALPHANUMERIC  TITLE.  ITITlE,  OF  NVyQRDS  (MAX  12).  THIS 
FUNCTION  RETURNS  THE  NUMBER  OF  NON-BlANK  CHARACTERS.  (FOR  USE  IN 
PLOTTING  CENTERED  TITLES) 

DIMENSION  ITITLL(NWORDS)  . I  CHAR (  120) 

DATA  IBLANK/lOH  / 

C 

MAXChR  =  lO’NWORDS 
ENCODE! 7 . 200 . I FMT )  MAXChR 
C 

DECODE (MAXCHR.  IFMT.  ITITLE)  I  CHAR 
C 

DO  110  1=1. MAXCHR 

NCHAR  =  MAXCHR  -  I  1 

I F (  I  CHAR (NCHAR )  . ME .  IBLANK )  RETURN 

110  continue 

NChAR  =  0 
RETURN 
C 

200  FORMAT! 1H( . 13 . 3HA 1 ) ) 

END 


137 


ooorjonnnnnnoo 


§7A.  PLOTTING  RADIANCES 


subroutine  PPmILOG(ITVPE.NYPlT.IYPlT, I  theta ) 

ON  NHM6/PPHIL0G 

THIS  ROUTINE  PLOTS  THE  LOGARITHM  OF  THE  DIFFUSE  OR  TOTAL  RADIANCE 
AS  A  FUNCTION  OF  PHI  FOR  A  GIVEN  THETA  VALUE. 

ALL  V  values  ARE  DISPLAYED  ON  THE  SAME  GRAPH. 

IF  ITYPE.EQ.7.  THE  DIFFUSE  RADIANCES  ARE  PLOTTED 
IF  ITYPE.EQ.8,  the  TOTAL  RADIANCES  ARE  PLOTYED 

IF  ITHETA  .GT.  0.  PLOT  UPWARD  RADIANCES  N C +THETA , PHI . Y )  =  RADP 
IF  ITHETA  .LT.  0.  PLOT  DOWNWARD  RADIANCES  N ( -THET A , PH I . Y )  =  RADM 

PARAMETER(MXMU= 10 .  MXPHI=24,  MXY=30) 
parameter (MXPTS=MXPHI +3) 

C 

COMMON/CGRID/  TmETA(MXMU) . PHI (MXPHI ) . Y(MXY ) 

COMMON/CRADIF/  RADAP (MXMU . MXPHI ) , RADP ( MXMU , MXPHI .MXY) . 

1  RADAM(MXMU .MXPHI ) , RADM ( MXMU , MXPHI .MXY) 

COMMON/CRADIR/  R ADO A P (MXMU . MXPH I ) . RADO AM ( MXMU . MXPH I ) . 

1  RAD0M(MXMU .MXPHI .MXY) 

COMMON/CMISC/  I M I  SC ( 20 ) . FM I  SC ( 20 )  . NT  I T . 1 T I TL E ( 8 ) 

COMMON/CWORK/  XPLT ( MXPT S . MXY ) . YPLT ( MXPT S . MXY ) .BCD(5) 

C 

DIMENSION  IYPlT(MXY) 

C 

DATA  XINCH . Y I NCh/4 . 0 . 5 . 0/ .  H . BOX/ 0 . 15 .  I  . 0 / ,  EPS/1. £-12/ 

DATA  ISYMBL/0/ 

C 

IT  =  IABS( ITHETA) 

NPHI  =  IMISC(2) 

NY  =  IMISC(4) 

NPHll  =  NPHI  f  1 
PI  =  FMISC(l) 

RADEG  =  FMISCO) 

TWOPI  =  2. ‘PI 
PI2  =  0.5*PI 
HBOX  =  H*B0X 
lYMAX  =  NY 

I F ( NYPlT . GT . 0)  lYMAX  =  NYPLT 
C 

IF ( I  Type . EQ. 7)  then 
FACT  =  0. 

ELSEIF( ITYPE . EQ . 8)  THEN 
FACT  =  1. 

ELSE 

WRITE(6.800)  ITYPE 
return 

ENDI  F 

CALL  PL0T( 1 . . 2 . . -3) 

C 

c  determine  the  allowed  range  of  Y  values 
c 

lYT  =  1 
IY8  =  NY 

I  F ( I  theta . EG. 0 )  GO  TO  99 
C 

C  CHECK  FOR  ZERO  UPWARD  RADIANCE  AT  THE  BOTTOM  (NAKED  SLAB  CASE) 

IF ( I  theta . LT . 0 )  GO  TO  98 
lYS  =  NY  -  1 

DO  90  J= 1 , NPHI 

I F ( RADP ( I T . J . NY )  . GT . EPS»RADM( 1  I  . J . NY )  )  lYB  -  NY 

90  CONTINUE 
GO  TO  99 

C  CHECK  FOR  ZERO  DOWNWARD  RADIANCE  AT  THE  TOP  (NAKED  SLAB  CASE) 

98  lYT  =  2 

DO  91  J= 1 . NPHI 

IF (RADM( I T , J .  1 )  . GT . EPS)  I  YT  -  1 

91  CONTINUE 

99  CONTINUE 
C 
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c 

c 


c 

c 

c 


c 

c 

c 


DEFINE  ARRAYS  FOR  PLOTTING 


DO  100  K=1.IVMAX 
lY  =  lYPLT(K) 

IFIIY.EQ.l  .AND.  lYT.NE.l)  GO  TO  100 
IFdY.EQ.NY  .and.  IYB.NE.NY)  GO  TO  100 
DO  101  J=1,NPHI 
XPlT(J.IY)  =  PHI(J) 

IF(ITHETA.GT.O)  TmEN 

YPLTCJ.IY)  =  ALOG10(RAOP< I T . J . I Y) ) 

ELSE 

VPLT(J.IY)  =  AL0G10(RADM{IT.J.IY)  FACT»RADOM(IT 
ENDIF 

101  CONTINUE 

XPlT (NPHI 1 , I Y )  =  rwOPI 
100  VPLT(NPmI 1 . lY)  =  VPLT(1,IY) 


find  The  maximum  and  minimum  values  to  be  plotted 

RADMAX  =  -1.E30 
RADMIN  =  1.E30 
DO  no  K=  1  .  I  YMAX 
I  Y  =  I YPlT ( K ) 

IFIIY.EQ.I  .AND.  lYT.NE.l)  GO  To  110 
IF(IY.£Q.NY  .and.  IYB.NE.NY)  GO  TO  110 
DO  111  J=1,NPHI1 
RAO  =  YPLT( J , I Y ) 

I F ( RAD . GT . RADMAX )  RADMA>  '  RAD 
I F ( RAD . lT . RADMI N )  RADMIN  =  RAO 
111  CONTINUE 
110  CONTINUE 


LABEL  The  vertical  AXIS  FOR  A  l.UG  PLOl 


MINH  =  IFIX(RADMIN) 

I F { RADMI N . LT . 0 . )  MINH  =  MINH  -  1 

MAXM  =  IFIX(RADMAx) 

1 F ( RADMAX . GT . 0  I  MAXH  =  MAXH  *  1 

MRANGE  -  MINH  -  MAXH 
IDlV  =  IABS(MRANuE) 

002  IF(5.lE.I0IV  .and.  IDIv.lE.IO)  GO  10  JUO 
I  F  (  lOI  V  .  GT  .  10  )  1,0  TO  301 
IDIV  =  I0IV*2 
GO  TO  302 

301  IDIV  =  (  IDIV  <•  l)/2 
GO  TO  302 

300  DLABL  =  FLOAT! IABS(MRAnGE) I/FLOATIIDIV) 

IFIOLABl . LE . 1 . )  GO  TO  303 
I  F  (  Fl  oat  (  I  F  I  X  (  Ol  abl  )  )  .  EQ  .  DI.ABL  )  go  to  303 
MRANGE  ^  iaiV*IF 1x(DlABL  ^  1.) 

GO  TO  300 

303  DINCH  -  YINCm/F^UAT( IDIV) 

IDIVl  =  IDIV  I 
C 

call  plot ( 0 .  , Y I NCh , 2  ) 

XX  =  -7.6*hBOx 
DO  310  I = 1 , 1 D I y 1 

YY  =  YINCM  -  O.A5*H  -  F LOAT ( I  -  1 ) ‘ D 1 NCH 
FLABl  =  FlOATIMAXh)  -  FLOAT! I  -  1 ) *DlA6l 
ENCODE ! 8 . 3  1  1  . BCD )  FLABl 
310  call  symbol ! XX , yy , H , BCD , 0 . 0 . 8 ) 

XX  =  -1.2 

YV  =  0.5*VINCH  -  b.5*MBOX 

call  SYMBOL(XX,VV,h, 13HLOG1RADI ANCE ) .90.0. 13 ) 

C 

c  define  scale  factors  consistent  with  The  labels 

c 

do  200  K---  1  ,  I  VMAX 
I  V  =:  I  YPlT  (  K  ) 

IFIIY.EQ.I  .AND.  lYT.NE.l)  GO  TO  200 
IFCIY.EQ.NY  .and.  IYB.NE.NY)  GO  TO  2ijO 
xplt ( nphi n  1 , 1 V  )  =  0 . 

XPlT (NPHI  1-2  ,  : Y )  -  pi  2 

VPLT ( NPHI 1- 1 , I Y )  =  FLOAT(MINH) 

200  YPlT ( NPHI  1  +  2  ,  I Y  )  ^  FLOATIMAXH  -  MINH)/YINCH 


.  I  V)  ) 
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C  LABEL  The  horizontal  axis  in  degrees 

c 

CALL  PL0T(0. ,0. .3) 
call  PL0T(XINCH. J. .2) 

VI  =  -0.45»H 
V2  =  -2,35»M 

call  symbol ( 0 Y 1 , H . 13 . 0 1 ) 

call  SYMBOL(0.-0.5»HaOX,Y2.M, IHO.O. . 1) 

call  SYMBOL ( 0 , 25«XI NCH .YI.M.13.0  .-1) 

call  symbolic . 25*XI NCH-MBOX . v2 .h . 2M90 . 0 . .2) 

call  Symbol ( 0 . 6»x I nch , VI .h . 13 . 0 .  .  - 1 ) 

call  symbol ( 0 . 5 ’X I NCM- 1 . 5*HB0x , y 2 . H , 3m IBO  0  3) 

CALL  SYMBOLIC . 75*XlNCH,yi .H. 13 .0 n 

call  SYMBCLI C . 75*XI NCM- 1 . 5»hBCx , y2  h  3m27C  0  3) 

CALL  SYMBClIXINCM , Y1 .H,  13 .0 .  .  -  1 ) 

CALL  SYMBOL IXI NCH- 1 . 5»H60X , Y2 ,H . 3H36C , C . ,3) 

CALL  S YMBOL 1 0 . 5 »XI NCH- 7 . ‘HBOX . -4 . *n . H .  1 4HPHI  IN  DEGREES, 0. 

IFtITYPE.EQ.7)  THEN 

1 F I ITHETA . GT . 0 )  THEN 

ENC0DEI4 1 .210, BCD)  THETA  I  I T ) *R ADEu 

NCHAR  =  41 

ELSE 

ENCODE  I  43 , 2 12, BCD)  ThETA I  I T ) »R ADEG 
NCHAR  =  43 
ENDI  F 

ELSE 

IF  I ITHETa . GT . 0  )  THEN 
ENC0DEI39,214,BCD)  THETAIIT)*HADEG 
NCHAR  =  39 
ELSE 

ENC0DE(41 , 2 16, BCD)  THETA  I  IT ) ♦RADEG 

NCHAR  =  41 

ENDIF 

ENOIF 

XX  =  0.5»XINCH  -  0 . 5»FL0ATINCHAR ) ♦HBOX 
CALL  SVMBOLIXX,-0.9.H.8CD.O.O.NCMAR) 

IFINTIT.GT.O)  Then 

XX  =  0.5*XINCh  -  0.5*FlOATINTIT)*HBOX 
CALL  SYMBOL  IXX  ,  y  I  NCH->-3 .0»H.H  .  ITITlE  0  NT  I  T  ) 

ENOIF 

plot  THE  RADIANCES 

DO  400  K=1.IVMAX 
lY  =  IVPLTIk) 

IFIIY.EQ.I  .and.  IVT.NE.1)  go  to  400 
IFlIY.EQ.NY  .AND.  IYB.NE.Ny)  GO  TO  400 
ENCODE! 10,401 .BCD)  VlIY) 

CALL  LINEIXPLTI 1,IY),YPLTI1.1V) .NPHI 1,1,1 SYMBL . 1 ) 

YV  =  I  YPLTINPHI  1  ,  I  Y)  -  YPlT  I  NPHI  If  1  ,  I  y  )  )  /  VPlT  (  NPHI  l-t  2  ,  I  Y  ) 

400  CALL  SYMBOLIXINCh, YY.H.BCD.O.O. 10) 

CALL  PL0T(-1. ,-2. ,-3) 

CALL  PLOTI 10. 0,0. 0,-3) 

WRITEI6.0O2) 

RETURN 

FORMATS 

210  format  I 35HDI FFUSE  UPWARD  RADIANCE  FOR  THETA  = . F6 . 2 ) 

212  FORMATI37HDIFFUSE  DOWNWARD  RADIANCE  FOR  THETA  =,F6.2) 

214  FORMAT! 33HT0TAL  UPWARD  RADIANCE  FOR  THETA  =.F6.2) 

216  FORMATI35HTOTAL  DOWNWARD  RADIANCE  FOR  THETA  = , F6 . 2 ) 

311  FORMAT! F6 . 2 . 2H  -) 

401  format I4H  Y  = , F6 . 2 ) 

BOO  FORMAT! •  ERROR;  SUB  PPHIlOG  lAllED  WITH  ITYPE  ='.I3) 

802  FORMAT! IH  END  OF  PPHILOG') 

END 


.  14) 


0 . 5»H 
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subroutine  PTHELQGC ITVPE . NVPlT . I VPLT, JPHI . JPI ) 

ON  NHM6/PTHEL0G 

THIS  routine  plots  THE  LOGARITHM  OF  THE  DIFFUSE  OR  TOTAL  RADIANCE 
AS  A  FUNCTION  OF  THETA  FOR  HALF  PLANES  DEFINED  BY  jPHI  AND  JPI. 

ALL  Y  VALUES  ARE  DISPLAYED  ON  THE  SAME  PLOT. 

IF(ITYPE.EQ.3,  THE  DIFFUSE  RADIANCE  IS  PLOTTED 
IF(ITYPE.E0.4.  THE  TOTAL  RADIANCE  IS  PLOTTED 

PARAMETER(MXMU=10,  MXPHI=24,  MXY=30) 

PARAMETER (MXPTS  =  4»MXMU+  1  .  MXY 1=MXY+1 ) 

COMMON/CGRID/  THETA ( MXMU ), PHI ( MXPHI ). V ( MX V ) 

COMMON/CRADIF/  RADAP ( MXMU , MXPHI ) . RADP ( MXMU , MXPHI .MXY) . 

I  RADAM(MXMU. MXPHI ) , R ADM ( MXMU . MXPh I .MXY) 

COMMON/CRADIR/  R ADO AP ( MXMU . MXPHI ) . R ADO AM ( MXMU . MXPHI ) . 

I  RADOM(M.XMU, MXPHI  .MXY) 

COMMON /CMI SC/  I  MI  SC ( 20 ) . FM I  SC ( 20 ) . NT  I T . I T I TLE ( B  ) 

COMMON/CWORK/  XPLT(MXPTS,MXY1) . YPlT ( MXPTS . MX Y 1 ) .BCD(4) .NPLT(MXYl) 

DIMENSION  IYPLTIMXY) 

DATA  XINCH. V INCM/4 . 0 .5 . 0/ .  H . BOX / 0 . 15 . 1 . 0 / .  EPS/1. E-12/ 

DATA  ISYMBL/0/ 

NMU  =  IMI SC( 1 ) 

NY  =  IMISC(4) 

PI  =  FMISC(l) 

RAOEG  =  FMISC(3) 

PI2  =  0.5*PI 
lYMAX  =  NY 

IF (NYPL r . GT . 0 )  lYMAX  =  NYPLT 
HBOX  =  H*80X 
IF(ITYPe.£Q.3)  Then 
FACT  =  0. 

ElS£IF(ITVPE.EQ.4)  THEN 
FACT  =  1. 

else 

WRITE(6,800)  ITVPE 
RETURN 
ENDIF 

CALL  PLOT(  1.  .2.  ,-3) 

DETERMINE  THE  RANGE  OF  THETA  AT  THE  FIRST  AND  LAST  lY  VALUES. 

DO  NOT  plot  zero  RADIANCES.  CHECK  FOR  ZERO  DOWNWARD  RADIANCE  AT  THE 
TOP  AND  FOR  ZERO  UPWARD  RADIANCE  AT  THE  BOTTOM  (NAKED  SLAB  CASES). 

lYTP  =  IVBP  =  0 

EPSREL  =  EPS*RADM( 1 . JPHI . I yPLT{ I VMAX) ) 

DO  700  1=1. NMU 

IF(RADM{I  .JPHI  ,  IYPlT(  1)  )  .GT. EPS)  lYTP  =  1 
I F ( RADM{ I  . JPI  .  I YPLT (  1  )  )  . GT . EPS)  lYTP  =  I 
IF (RADP( I . jPhI . I VPLT ( I VMAX) ) . GT . EPSREL)  lYBP  =  1 
I F ( RADP( I . JPI . I yPLT( I VMAX ) ) . GT . EPSREL)  lYBP  =  1 
700  continue 

DEFINE  the  arrays  TO  BE  PLOTTED 
c  POLAR  CAPS  Always  have  a  phi  Index  of  i 

c 

LY  =  0 

I F ( I YTP . EQ . 1 )  UO  TO  200 
IF ( I VPlT( 1 ) , NE . 1 )  GO  TO  200 
L 

C  special  CASE:  The  TOP  boundary  REOUIRES  TWO  PLOTS  FOR  A  NAKED  UPPER  BOUNDARY 

C 

L  V  =  L  V  I 
L  =  0 
L  =  L  »  1 

XPLTIL.LV)  =  THETA(NMU)  -  PI 
YPlTCL.LV)  =  AL0G10(RA0P(NMU. 1 . 1) ) 
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DO  100  I=2,NMU 
L  =  L  ♦  1 
I  I  =  NMU  -  I  +  1 
XPLT(L,LV}  =  THETA(II)  -  PI 
100  VPLT(L.LV)  =  ALOG10(RADP( 1 1 , JPHI  .  1 ) ) 

C 

NPLT(LY)  =  L 
C 

LV  =  LV  ♦  1 

L  =  1 

DO  110  I=1,NMU-1 
L  =  L  +  1 

XPLT(L.LY)  =  PI  -  TMETAd) 

110  VPLTCL.LY)  =  ALOG10(RAOP( 1  . JPI  .  I  )  ) 

L  =  L  +  1 

XPLT(L,LV)  =  pi  -  THETA(NMU) 

VPLTCL.LV)  =  ALOG10(RAOP(NMU . 1 . 1 ) ) 

NPLT(LV)  =  L 
C 

200  DO  150  K=l, IVMAX 
IV  =  IVPLT(K) 

IFdV.EQ.l  .AND.  LY.GT.Q)  GO  TO  150 
LY  =  LV  +  1 

L  =  0 

IFdY.EQ.NY  .AND.  IVBP.EQ.O)  GO  TO  lb9 
C 

L  =  L  +  1 

XPlT(L,LY)  =  THETA(NMU)  -  PI 
YPLT(L,LY)  =  AL0G10(RADP(NMU.  1. IV)  ) 

00  160  1=2. NMO 
L  =  L  ♦  1 
I  I  =  NMU  -  I  1 
XPlT(l,LY)  =  THETAdI)  -  PI 
160  YPLT(l,LV)  =  AL0G10(RADPd I . JPHI  . I  V) ) 

C 

169  DO  170  I=1,NMU-1 

L  =  L  •>  1 

XPLT(L,LY)  =  -TMETACI) 

170  YPLT(L,LY)  =  AlOG 1 0 ( R ADM (I . JPHI , I Y )  »  F ACT *RAD0M( I . JPHI . 1 V ) ) 
C 

L  =  L  1 

XPLT(L,lV)  =  -THETA(NMU) 

VPLT(L,LY)  =  Al0G10(RADM(NMU .  1  ,  I  V  )  t  FACT‘RAD0M(NMU ,  1 .  I  V ) ) 

00  180  I=1,NMU-1 
L  =  L  1 
I  I  =  NMU  -  I 
XPLT(L,LY)  =  THETAdI) 

180  YPlKL.LV)  =  AL0G10(RADMd  I  .  JPI  .  IV)  F  ACT  •  R  ADOM  (I  I  ,  J  P  I  ,  I  Y  )  ) 

C 

IFdV.EQ.NV  .AND.  IVBP.EQ.O)  GO  TO  149 
C 

DO  190  I=1,NMU“1 
L  =  L  1 

XPLT(L,LY)  -  PI  -  THETAd) 

190  YPLT(L,LY)  =  ALOG10(RAOPd , JPI . I Y) ) 

L  =  L  +  1 

XPLT(L.LY)  =  PI  -  TH£TA(NMU) 

YPLT(L.LY)  =  AL0G10(RADP(NMU.  1 ,  I  V)  ) 

C 

149  NPLT(LV)  =  L 

150  CONTINUE 
NUMPLT  =  LV 

FIND  THE  MAXIMUM  AND  MINIMUM  VAluEN  TO  BE  PLOTTED 

RADMAX  =  -1.E30 
RADMIN  =  1.E30 
DO  500  L Y= 1 , NUMPlT 
NPTS  =  nplt(ly) 

DO  500  j=l . NPTS 
RAD  =  YPLT(J,LY) 

I F ( RAD . GT . RADMAX )  RADMAX  =  RAD 
I F (RAD . LT . RADMIN)  RADMIN  =  RAD 
500  continue 
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C  LABEL  THE  VERTICAL  AXIS  TOR  A  LOli  PlOT 

C 

MINH  =  IFIX(RADMIN) 

I F ( RADMIN . LT . 0 . )  MINH  =  MINH  -  1 

MAXH  =  IFIXIRADMAX) 

IF(RADMAX.GT.O)  MAXH  =  MAXH  ♦  1 

MRANGE  =  MINH  -  MAXH 
IDIV  =  IABS(MRANG£) 

302  IF(5.LE.IDIV  .AND.  IDIV. LE. 10)  GO  TO  300 
I F ( IDI V. GT . 10)  GO  TO  301 

IDIV  =  IDIV»2 
GO  TO  302 

301  IDIV  =  {IDIV  «■  l)/2 
GO  TO  302 

300  DlABL  -  FLOAT( lABS(MRANGE) )/FLOAT( IDIV) 

I F ( DLABL . LE . I . )  GO  TO  303 

I F ( FLOAT ( I F I X( DlABl ) ) . EQ . OLABL )  GO  TO  303 
MRANGE  =  IDlV»IFlXtDLABL  +  1.) 

GO  TO  300 

303  OINCH  =  VI NCH/FLOAT ( IDI V) 

IDIVl  =  IDIV  ♦  1 

C 

CALL  PL0T(0. ,0. ,3) 

CALL  PL0T(0. ,YINCH, 2) 

XX  =  -7.6«60X»H 
DO  310  I  =  1  , IDI VI 

VV  =  VINCH  -  0.45*H  -  FLOAT! I  -  1  ) •OINCH 
FLABL  =  FlOAT(MAXm)  -  FLOATd -  1 ) »DlABL 
ENCODECa , 31 1 .BCD)  FlABL 
310  CALL  SVMBOL(XX,YV.H.BCD.0.0.6) 

XX  =  -1.2 

VV  =  0.5*VINCH  -  6.5»B0X*H 

CALL  SYMBOL ( XX , V V , H , 1 3HLOG { R AD I ANC E ) .00.0. 13 ) 

LABEL  the  horizontal  AXIS 

CALL  PLOT(0. .0. .3) 
call  PL0T(XINCH.0. .2) 

C 

VI  =  -0.4b«r. 

V2  =  -2.35*H 

CALL  SVMBOlCO .  . V  1  ,H.  13. 0 .  . -  1) 

CALL  symbol (0. -2. •HB0X.y2,H.4H- 180.0. .4) 

call  symbol! 0 . 2b*XINCH.Vl.H.13.0..-l) 

call  Symbol ( 0 . 25»XI nCH- I . 5*hB0X . y2 .h. 3h-90 . U . . 3 ) 

CALL  symbol ( 0 . 5*X INCH .yi.H.13.0..-l) 

call  SYMBOL(0.5*xrNCH-0.5«M80X.V2.H. IHO.O. . 1 ) 

call  symbol (0 . 75*XINCH. VI, H. 13.0. .-1) 

call  SYMBOL ( 0 . 7S»XINCH-HB0X. V2 .H. 2H90 . 0 . , 2 ) 

call  symbol ( XINCh , Y I .H ,  13 . 0 .  . - I ) 

call  symbol ( X  inch- 1 , 5»HB0X . Y2 .H. 3H18U . 0 .  . 3 ) 

call  symbol (0.5*aINCH-15.*HBOX.-4.*h.H. 

1  30HVIEWING  ANG:  t  THETA  IN  DEGREE S . 0 .. 30 ) 

C 

HI  =  0 . 7»H 
HlBOX  -  0.7♦HBO^ 

ENCODE (  1  1  , 2  10 , BCD  )  RAOEG'PHI  ( JPI  J 

CALL  Symbol (0.25»XINCH'5.5*H1BOX.-0.95,h1.BCO.O..H) 
ENCODEC 11.2I0.BCCI  RAOEG* PH I( jPhI ) 

call  Symbol (o.ts'xinch-b. 5 ‘hi box .-d.ob.hi.bcd.o.  ,11) 

c 

I  F  (  I  TYPE  .  EO  .  3  )  '"HEN 

call  SYMBOLiO-E^XlNCH-ZZ. S*mB0X .  -  1  .  J . n , 

1  45HDIFFUSE  FTei,0  RADIANCE  AS  A  FUNCTION  OF  THETA, 0., 45) 
else;  Fd  type  .  EO  .  4)  THEN 

call  SYMBOl(0.5*XINC'.-21 . 5*hB0X  .  -  1  .  ,3  .  H  , 

I  43HT0iAL  FIElD  RADI'NCE  AS  A  FuNCTI(>N  OF  Th£TA,0.,43) 
ENDI  F 

C 

C  PLOT  The  R£FER£N(,E  LINE  AT  ThE'"A  =  0  AND  THE  TITLE 

call  Plot ( 0 , 5*x I nch , 0 . . 3 ) 

call  da SHPT ( 0 . 5* X  I NCh , Y I NLH , 0 .  1 ) 

I F (NT  I T . GT . 0 )  Then 

XX  =  o.5*xin(;h  -  u  .  5«floa  r  ( NT  I  T  )  •mbox 

call  SYMB0L(XX . yINCha3 ,0*H.H, ITITlE.O. .NTIT) 

ENDI  F 
C 
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C  PLOT  THE  RADIANCES 

C 

I  V  =  0 

DO  400  LY= 1 , NUMPL  T 
NPTS  -  NPlT(lY) 

XPLT (NPTS+ 1 , LY )  =  -PI 
XPLT  (NPTS'^2  ,  LY  )  =  PI2 
VPLT ( NPTS+ 1 . LV )  =  FlOAT(MINH) 

YPLT ( NPTS+2 , LY )  =  FL0AT{MAXH  -  MI NH ) / V  I NCH 
CALL  LINE (XPlT( I.LY).VPLT(I.LV). NPTS .1.1 SVMBL . 1 ) 

IFIlY.EQ.I  .and.  NUMPlT. GT . NYPLT)  go  to  400 
I  Y  =  I Y  1-  1 

ENCODE!  10 , 40  1  . BCD)  V(IVPLT(IY)) 

YY  =  (YPLT(NPTS,LY)  -  Y PL T ( NPT Sf 1 . L Y ) ) / Y PL T ( NPT S+ 2  ,  LV )  -  0 . 5«H 

CALL  SYMBOLIXINCH, YY.H.BCD.O.O. 10) 

400  CONTINUE 
C 

CALL  PLOT! -  1 .  , -  2 .  . -3 ) 

CALL  PLOT! 10 . 0 . 0. 0. -3) 

WRITE!6.802) 

RETURN 

C 

c  formats 

C 

210  F0RMATI5MPHI  =.F6.1) 

311  F0RMAT(F6. 2. 2h  -) 

401  F0RMATI4H  Y  =,F6.2) 

800  FORMAT!'  ERROR;  SUB  PThELOG  CALLED  WITH  ITvPE  =',I3) 

802  FORMAT! •  END  OF  PThELOG') 

END 


Subroutine  piheplr  o  type  . nyplt  ,  i  vpi^t  jphi  jpi  ) 

c 

C  ON  NHM6/PTHEPL.R 

C 

C  THIS  routine  MAXES  A  POLAR  PlOT  OF  THE  LOGARITHM  OF  THE  DIFFUSE 

c  OR  total  radiance  as  a  function  of  theta  for  half-planes  defined 

C  BY  JPHI  AND  JPI.  A  SEPARATE  PLOT  IS  MADE  FOR  EACH  DEPTH 

C 

C  IF  ITVPE. EO.l.  The  DIFFUSE  RADIANCE  IS  PLOTTED 

C  IF  ITVPE, EQ, 2,  The  TOTAL  RADIANCE  IS  PLOTTED 

PARAME ter ( WxMO= 10 .  MXPHl=24.  MXyiJUJ 
PARAMETER ( Mx PT S = 4 »MXMU+ 1 ) 

C 

COMMON /COR  ID/  I hET  A ! MXMu )  . PHI ( MxPHl  )  , yUD! MXY ) 

COMMON /CRADIF/  RADAP(MXMu.MxPhI ) .RADP!MXMU,MXPHI .MXY) 

1  RADAM ( MXMu , MXPHI I . RADMI MXMU . MXPhI , MXY ) 

COMMON /CRADIR/  RADOAPIMxMu.MxPhI  )  .RAUUAM{MXMU.MXPHI  )  . 

1  RAD0M( MXM j , MXPhI . MXY ) 

COMMON/ CM I  SC/  IMISC(2U)  .FMIbCI  2ll)  .NTll  .  1  IITlE!8) 

COMMON /C  WORK/  X(MXPTS).Y(MXPT^,),Ri.  (VU) 

C 
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DIMENSION  TITLE{6) , lYPLT(MXV) 

C 

DATA  ISYMBL/1/.  RINCH/3.Q/.  DICIRC/0.5/,  H , BOX/0 . 15 , 1 . 0/ 

C 

call  PL0T(4. ,5. , -3J 
C 

NMU  =  IMISC(  I) 

NY  =  IMISC(4) 

PI  =  FMISC(l) 

OEGRAD  =  FMISC(2) 

RADEG  =  FMISC(3) 

P12  =  0.5*PI 
PI32  =  1.5»PI 
HBOX  =  M*BQX 
I F ( I  TYPE . EQ .  1  )  then 
fact  =  0. 

ElSEI F { ITYPE . EQ . 2 )  THEN 
FACT  =  1. 

ELSE 

WRITE(6,300)  ITYPE 

RETURN 

ENDIF 

lYMAX  -  NY 

I F ( NYPLT . GT . 0)  I YMAX  =  NYPLT 
C 

DO  888  X= 1 , I YMA> 
lY  =  IYPLT(K) 

convert  RADIANCES  AND  NMM  THETA  VALUES  (MEASURED  FROM  THE  +V 
AXIS)  TO  X  =  LOGCRADI ANCE )  AND  Y  -  CALCOMP  ThETA  (MEASURED  FROM 
THE  +X  AXIS) 

POLAR  CAPS  always  have  A  PHI  INDEX  OF  1 
L  =  0 

00  200  I=1,NMU-! 

L  •=  L  »  1 

X(L)  =  AlOGIOI RAOPd , JPHI . lY ) ) 

200  Y(L )  =  PI  2  -  THETA( I ) 

L  =  L  1 

X(L)  =  AlOGIO CRADP(NMU ,  1  . 1 Y )  ) 

Y( l)  =  PI2 
L 

DO  2U1  I -1. NMU -I 
L  =  u  *■  1 

I  I  =  NMU  -  I 

X(L)  =  ALOGIO(RADP( I  I  , JPI  .  lY)  ) 

20  1  Y  (  L  )  =  PI  2  theta  (  I  I  ) 

C 

DO  2U2  I=1,NMU-1 
L  =  L  ♦  1 

X(L)  =  AlOGIO ( RADM{ I , JPI . 1 Y)  +  FACT*RAD0M( I . JPI . 1 Y ) ) 

202  Y(l )  =  PI32  -  ThETA( I ) 

L  =  L  +  1 

X(L)  =  ALOG  10  (  RAOM  (  NMU  .  1  .  I  Y  )  F  ACT  *RADOM  (  NMU  .  1  .  I  Y  )  ) 

V(L )  =  PI32 

C 

DO  203  I=1,NMU-1 
L  =  L  ♦  1 

II  =  NMu  -  I 

X(L)  -  Al0G10(RADM(  I  I  .  JPHI  .  lY)  FACT»RADOM(  I  I  .  JPHI  ,  I  Y  )  ) 

203  Y{l)  =  PI32  t  ThETAI I  I  ) 

C 

L  =  L  »  1 

X (  L  )  ^  X(  1  ) 

V( L )  =  Y (  1  ) 

NPTS  =  L 
C 

c  find  The  maximum  and  minimum  uUG  values  to  be  plotted 

c 

RADMAX  -  -l.OESU 
RADMIN  =  1.0E30 
DO  250  L=1,NPTS 
RAD  X  (  L  ) 

I K RAD , GT . RADMAX )  RADMAX  -  RAD 
I F ( RAO . lT , RAOM; N ;  RADMIN  =  RAO 
250  CONTINUE 


145 


§7A.  PLOTTING  RADIANCES 


c  label  The  radial  (vertiC'<l)  ax:s  for  a  log  plOt 

c 

mink  =  IFIX(RADMIN) 

I F ( RAOMI N . L r , 0 . ;  MINm  =  MINH  -  / 

MAXH  =  !FIX(RADMAX) 

I  F  (  RADMAx  .  GT  ,  0  )  MAXFI  =  MAXK  1 
MRANGE  -  MINH  '  MAXH 
IDIV  =  IABSCMRANGE) 

302  1F(3.LE,IDIV  .AND.  10IV.LE.6)  GO  TO  300 
I F lID W . GT . 6 )  GO  TO  301 

IDIV  =  IDI V»2 
GO  TO  302 

30  1  IDIV  =  (IDIV  1  )/2 
GO  TO  302 

300  DLA0L  =  Float  (  I  AEilMRANGE  )  )  /  F^OAT  1  101  .' ) 

IF (DLABL . LE . 1 . )  GO  TO  303 
I F  (  Float  ( I F I  x( Olabl  ) ) .  EQ . olabl  )  ijO  to  ,iu3 
MRANGE  =  IDI  V«  I  F  I  X  (  DLABl  -x  1.) 

GO  TO  300 

303  DINCH  =  RINCh./FlUAT  (  lOIVj 
C 

call  Plot ( o . , -r i nch , 3 i 
call  plot (Q . , R INCH . 2) 
call  plot ( -R inch . n . , 3 ) 
call  PL0T{ -  1  .  1 , 0 .  , 2) 
call  Plot ( 0 .  , C .  ,  3  I 
call  f-’L0T(RINLH,r.,2) 

XA  -7.b»BOX*H 
DO  3  10  I  -  .  I  DI  V'  1 

vv  -  RINCM  -  O.A5*H  -  F lOAT ( I  -  1  ;  *0 1 NCk 
RC(!)  =  RINCH  -  FlCAT (  I  -  1  ) •OINCh 

FLABL  =  FlDATIMAlH)  -  F  lOA  T  V  I  •  1  I  •  D.  AtiL. 

EN(  DDE  (  e  .  -T  1  ,  B.  i.  F(  aBl 

310  call  SVMBOl ( XX . lv , k . BlD . 0 . 0 . fa ) 

XX  =  -1.1 

yv  =  0.5*RINCH  -  o.5*B0X»m 

call  symbol  (  X>  ,  -  -  .  Ff.  IOHLOGI  RADI  an;  L  .)  ,90.0, 13) 

C 

c  DRAW  MA.lNITuDE  ::''-ClFS 

c 

DO  2  60  I-l.IDI" 

R  =  Rt.  I  !  ) 

I  F  (R  .  G^  .  1  .  30  )  >■>.:  K 

TmO  -  90.0  *•  RAOEGFASlri,  1  .  3'3/R ) 

EL SE I F ( R . L £ . 1 . 75  .AND.  R . GT . 0 . 1 )  ThEN 
ThO  =  180.  F  RADEG* ASI N( 0 . 1 /R ) 
else 

THO  =  lao.o 

ENOI  F 

XS  -  R  *  LOS  (  DE&P  AD  x  r  r'L’ ) 
vS  =  R»iIN(DEOR‘-D»lHj, 

CA^_  c  I  RClE  (  aD  .  :  ,  ThO  .  3tiC'  .  .  A  .  R  ,  i.  ‘  C  1  R C  ) 

2  fa  u  call  C  I  C  l  E  I  K  .  J  .  .  j  .  .  9  ‘ .  .  .  F  .  R  .  D  I 1  R  L  ' 

r 

c  'J  0  1  tNij  iHtiA  T(j  K  AND  V  iN  iNLMtb 

(. 

Cl  =  ^  i  'tCf''  ''  ^  u  .2'*  ’  (  '  ■ 

CZ  -  -  F  !  OA  T  :  M  T  N-*  j  1 
DO  5u0  w - i . Nf  ' 

R  :  N  =  c  1  *  !  1-  !  • 

)  -  R  I  r-i  *  ^  •  V  L  n 

bl;U  V  (  L  )  -  r  1  N*  T  I  N  ^  I  J  ■■ 

(  scale  t  f-.  t  ^  A  ■  K  I  ' , '  S 

c 

X  1  f^PTS*-  1  )  -  , 

V ( NPTSf 1 )  =  0 . 

X(NPTS»2  )  =  1  . 

V'NPTS»2)  =  1  .  D 

c 

r  Pi  )T  RADIANi'ES 

L 

LAl  L-  L  I  NE  I  X  .  V  ,  '  S  ,  1  ,  I  SVMBL  .  1  ) 

c 

C  lABE_  The  Pl(jT 
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IFCITVPE.EQ.  1)  THEN 
tNC0DE(52. 400. TITLE)  VODflV) 

CALL  SYMBOL! -26. 0«HBOX, -4 . ,M, TITLE. 0. .52) 
else 

ENC0DE(50, 402. TITLE)  VOD(IV) 

CALL  SVMBOL(-25.0»HBOX.-4. .H. TITLE, 0. .50) 

ENDIF 

CALL  PL0T(0  .  .-3.6,3) 

CALL  PLOT(0  .  ,-3.2,2) 

ENCODE ( 26,404 .TITLE)  RADEG*PMI ( JPI ) . RADEG*PHI ( JPHI ) 

CALL  SYMBOL!- 13 . •HBOX, -3 . 5 ,H, TITLE , 0 . ,26) 

IF!NTIT.GT.O)  THEN 

XX  =  -0.5»FL0AT!NTIT)*h80X 

CALL  SYMBOL!XX,RINCH+3.0*H.H, ITITlE.U. ,NTIT) 

ENDIF 

C 

888  CALL  PLOT  !  10. 0 . 0. 0, -3) 

C 

CALL  PLOT ! -4 . , -5 . , -3 ) 

WR1TE!6,802) 

RETURN 

C 

400  F0RMAT!46H0IFFUSE  RADIANCE  AS  A  FUNCTION  OF  ThETA  AT  Y  =,F6.2) 
402  F0RMAT!44HT0TAL  RADIANCE  AS  A  FUNCTION  OF  THETA  AT  Y  =.F6.2) 
404  F0RMAT!5HPHI  = . F 6 . 1 , 4X , 5HPH I  =.F6.1) 

411  F0RMAT!F6. 2 , 2H  -) 

800  F0RMAT!1H  ,'  ERROR;  SUB  PTHEPLR  CALLED  WITH  ITYPE  -'.13) 

802  FORMAT! IH  ,'  END  OF  PTHEPLR ' ) 

END 
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B.  Plotting  Chromaticity  Diagrams 

The  Natural  Hydrosol  Model  ci'-niputes  monochromatic  radiances.  However,  independent 
runs  of  the  NHM  can  be  made  at  \arious  wavelengths,  using  wavelength-dependent  input 
radiances  and  inherent  optical  properties,  and  the  results  can  be  combined  to  generate 
wavelength-dependent  output. 

It  is  often  of  interest,  e.g.  tn  remote  sensing,  to  plot  the  ocean  color  on  a  standard  C.I.E. 
chromaticity  diagram.  Program  MPCHRO  reads  13  data  values  corresponding  to  13 
wavelengths  (400  nm,  425  nm,  ',675  nm,  and  700  nm).  Each  datum  is  obtained  from  a  run  of 
Programs  4  and  5,  13  runs  in  all.  The  data  are  processed  using  standard  tristimulus  functions,  as 
described  in  Appendix  C,  and  plots  of  the  resultant  color  point  are  made  on  a  1931  C.I.E. 
chromaticity  diagram. 

In  order  to  compute  a  c'^^rrect  color  (e.g.  for  the  upward  radiance),  the  incident  radiance  on 
the  water  surface  must  have  the  coiTcct  color,  i.e.  wavelength  dependence  (corresponding,  say,  to 
the  solar  spectrum).  The  pro!'.-'  wavelength  dependence  of  the  incident  lighting  can  be  achieved 
by  adjusting  the  value  of  StITOTL  (input  record  6  in  Program  4)  in  each  of  the  13  NHM 
wavelengti',  runs.  However,  it  is  generally  more  convenient  to  make  all  NHM  runs  with 
SHTOTL  equal  to  some  nominal  value,  say  1.0  W  m  ^  nm’.  In  this  case,  the  output  values  of  the 
13  NHM  runs  must  be  adjusted  before  computing  the  chromaticity.  Subroutine  ATMOS  uses  a 
simple  model  atmosphere  anci  .solar  spectrum  (described  in  Appendix  D)  to  weight  the  13  data 
values  according  to  wavelcngut  and  solar  zenith  angle  before  proceeding  with  the  chromaticity 
calculation.s. 

1.  Input 

Two  records  are  read  to  specify  the  details  of  the  plot,  and  then  repeated  pairs  of  records 
are  read  to  specify  the  wave,"  igth  data  he  plotted. 

Record  1 :  LABPNT,  IPLBl  .h,  lA  l'MO.S 

l.ABi'NT  -  t)  it  the  plotted  points  are  nut  labeled. 

-  1  if  each  plotted  point  is  numbered  on  the  chromaticity  diagram,  and  a 

o.-parate  t.ib'e  of  numbers  is  plotted,  along  with  a  label  for  each 
'.umber  to  identify  the  plotted  points. 

IPLBf-L’  =  I'  'I  oitiy  the  full  ehroiiauieity  diagram  is  to  be  drawn. 

-  1  if  rinly  the  "blue  corner"  of  the  chromaticity  diagram  is  to  be  drawn. 

•  his  is  of'en  uwful  for  plotting  ocean  color,  which  usually  lies  in 
the  blue  region. 

=  2  if  both  (he  full  diagram  and  the  blue  corner  are  to  be  drawn. 

I.ATMOS  -  0  if  liu:  raw  data  values.  P( LAMBDA),  are  to  be  used  in  computing  the 

cidor. 

=  I  if  tfte  raw  data  values.  P(LAMBDA),  are  to  be  transformed  by  the 
a  inosphenc  model  of  .Appendi.x  D  before  use. 
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Record  2:  ITOP 

This  record  gives  a  title  for  the  top  of  the  plot.  Up  to  80  alphanumeric  characters  are 
allowed. 


Record  3:  ITITLE 

This  record  gives  a  label  for  the  plotted  point.  Up  to  80  characters  are  allowed. 

Record  4:  THETPS,  P(l),  P(2),  -,P(13) 

THETPS  is  the  zenith  angle,  in  degrees,  of  the  sun  in  the  run  of  Program  4  which 
generated  the  data.  If  lATMOS  =  1,  this  value  is  used  in  the  atmos¬ 
pheric  model  of  Appendix  D  to  correct  the  raw  data  values  P(I), 
1=  l.",13. 

P(l)  are  the  13  data  values  to  be  used  in  computing  the  color.  P(l)  corresponds  to 

:  wavelength  400  nm,  P(2)  to  425  nm,  ”,P(13)  to  700  nm. 

P(13)  Typically,  P(I)  is  the  radiance  in  a  given  direction  at  a  given  depth,  or 

an  irradiance  at  a  given  depth. 


Records  5  and  6, 7  and  8,--- 

Pairs  of  records  of  the  same  form  as  3  and  4  are  repeated  for  each  point  to  be  plotted.  Up  to  50 
points  are  allowed  by  the  dimensions  in  the  listed  code  (see  parameter  MXPTS  in  program 
MPCHRO). 
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2.  Code  Listing 


PROGRAM  MPCHRO( INPUT. OUT PUT, 1APL5=INPUT,TAPE6=0UTPUT.TAP£9B, 

1  rAPE99) 

C 

C  ON  NHM6/MPCIiR0 

C 

C  THIS  PROGRAM  COMPUTES  AND  PLOTS  CmROMAT I C 1 T I ES  ON  A  STANDARD  CIE 

C  1931  CHROMATICnv  DIAGRAM,  GIVEN  RADIANCES  OR  IRRADIANCES  AT  13 

C  WAVELENGTHS:  400.  NM ,  425.  NM .  45U .  NM ,  ....  675.  NM .  700.  NM 

C 

C  ALL  PLOTTING  IS  DONE  USING  STANDARD  CAlCOMP  CALLS 

C  (TAPEOa  AND  TAPE99  APE  USED  BV  Tl-lE  CAlCOMP  ROUTINES.  AS 

C  implemented  ON  THE  AUTHOR'S  CDC  CYBER  B55  COMPUTER.) 

C 

PARAMETER(NWAVEl -  13 .  MXPTS  =  5C) 

C 

DIMENSION  P ( NWAV  El )  ,  I WAVEL ( NwAVEt  )  . RAwP{NWAVEL ) 

DIMENSION  XCHR(y<PTb).VCHR(MApTS),lTUPI8).lTlTLE(B,MXPT3J 
C 

DATA  lWAVEL/4 00, 425, 450. 4 7 5. 5 00.525. 550. 575. 60 0.625, 65 0.675. 700/ 

READ  THE  UVERAl.  PLOT  SPECS.  AND  A  UIlE  eOR  THE  TOP  OE  THE  PLOT 

lABPNT  -  0,  IE  f'DINIS  ARE  NOI  lO  BE  LABELLED 

1,  IE  t.ACH  POINT  IS  NliWBERtO  AND  LABELLED 

IPlBLU  -  0,  IE  -iLV  'he  Eull  LHk,,yATlLl  tv  diagram  IS  TO  BE  DRAWN 

!,  IE  .NLY  The  Blue  l(,.-lpr  is  to  be  drawn 

2.  IE  fjTH  Full  and  Bi.ut  lORNER  are  to  be  drawn 

lATMOS  =  0.  IF  IhE  raw  P(lAMBL‘A;  ARE  TO  BE  USED 

1,  IF  the  raw  p(LAMeDA)  are  to  be  scaled  by  the  atmospheric  model 

IT0P,..A  TITlE  EUR  The  TOP  OF  TmE  plu!  LBO  CHAR  MA,\) 

NPTS  -  U 

READ!  5  .  ♦  j  LABPr: '  1  PlBL  :.'  .  I  atmL;S 

R£AD(5 .  100)  I  Top 
WR ! TE  f  6 , 90 ) 

99  NPTS  =  NPTS  ♦  ; 

READ  A  label  At.'o  A  SET  OF  vALUEs  ’O  BE  PRULESSED 

READ!  5  .  100  ,  END=9L)U  )  (  I  T  I  Ti  E  I  1  .  ^  s  )  .  1  -  1  ,  F  .1 

READ( 5 , *  . END  =  90  .  )  YmETPS.IPlI),!-!. NwAVEl  ) 

DO  150  I-l,NwAvE; 

150  RAvVP(I)  r-M, 

C 

C  scale  the  Eli)  /•-.lORDIN.,  To  TmF  a  'Mo.  sPi  iE  r  I  <  MODEL 

I  E  (  I  ATMOS  .  NE  .  i;  i  'Ail  a  tm()S  (  t  l-F  T  p  ■.  y) 

C 

(.  {.  C'M  T  L  '  H  ti  '■’I  -  ‘  M  A  T  I  C  i  ’’  V  .  )k  i  j  I  r<  A  '  J- 

call  vMA'(fv4P7Sj.Vi.  Mf-  (  •  ■.,  )  I .(  ^?vv  V  t  .  k  I  T  V  j 

c 

WfV  I  T  E  (  h  .  1' Ji;  )  ft-  :  S  .  i  I  T  I  T  I  r  I  1  .  NPT  s  )  ,  I  ,  1  ,  H  ) 

IF!  I  A  7  M  0  S  .  N  £  .  r  w  R  I  T  l  i.  6  ,  T  C  1  I”  H  E  '  R 
if*  R  1  T  t  i  o  .  I?  C*  ^  I 
Lj(j  /'(.1 2  11.  NwL 

2  u  2  >ARirc(b,Ai>-J^T  Ia‘vl.Li  L  /  ,  i  t  t  .?'«,>•(  i  I 

WR  I  TF  (  8  ,  )  X  mR  V  NPT  S  )  .  VCHR  ;  NPT  .  R'JR  I  TV 

f. 

GO  TO  99 
C 

(  DRAW  A  CmROMAII  ITv  [IIA.jRAM  AN'j  Ri.O’  PL»1nT‘>  (jN  JT 

C 

900  NRT'^  -  NPIls  -  ' 
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CALL  PLOTS 

CALL  PLOT(2. ,2. .-3) 

IF( IPLBLU. NE . 0)  call  PLTBLU ( XCHR . YCHR . NPT S . L ABPNT .  1  TOP , 1 T I TlE ) 
CALL  PLOTdO.  ,0.  ,-3) 

I F ( IPLBLU . NE .  1 )  CALL  PlTCHR (XCMR . VCHR . NPTS . L ABPNT .  I  TOP ,  I TI TLE ) 
CALL  PL0T(0.  ,0.  , -98) 

C 

C  FORMATS 

C 

90  FORMAT(lHl) 

100  F0RMAT(8A10) 

200  FORMATC///'  POINT  NUMBER '  , I  3 .  '  :  -.8X10/) 

201  FORMAT('  THE  ATMOSPHERIC  MODEL  WITH  THETPS  ='.F6.2.  IS  USED'/) 

203  FORMAT!'  THE  FUNCTION  OF  WAVELENGTH  GIVEN  BV ' / / 

1-  lambda  P(LAMBDA)  (RAW  P)'/) 

204  F0RMAT(I6. 1P2E16.4) 

206  FORMAT!/'  HAS  CHROMATICITV  COORDINATES  (X,V)  =  !'.F5.4.',  , 

1  F6.4.')  OR  (DOMINANT  WAVELENGTH,  PURITY)  = !  '  . F5 . 1  ,  '  .  '  . F6 . 4 ,  '  )  '  ) 
END 


Subroutine  atmos!thetps.p) 

c 

C  NHM6/ATM0S 

c 

C  GIVEN:  A  SET  OF  VALUES  P(I).  1=1  ....NWAVEL,  WHICH  ARE  THE 

C  OUTPUT  OF  13  NHM  RUNS  AT  TmE  13  NHM  WAVELENGTHS.  WHERE  EACH 

C  RUN  WAS  initialized  WITH  UNIT  SCALAR  IRRADIANCE.  THIS  ROUTINE 

C  SCALES  The  P(I)  values  to  reflect  the  wavelength  and  solar  angle 

C  DEPENDENCE  OF  THE  INITIALIZING  SCALAR  IRRAOIANCES.  ACCORDING 

C  TO  THE  MODEL  ATMOSPHERE  AND  SOLAR  SPECTRUM  DESCRIBED  IN 

C  APPENDIX  D  OF  this  REPORT. 

r 

PARAMETER!NWAvEL=13) 

dimension  P! NWAVEL), A LPHAL ( NwA VEL ) . SOL ARC ( NWAVEL ) 

DATA  SOlARC/1. 54,  1.89, 2. 20. 2. 20.  1.98. 1.92, 195,  1.87.  1,81,  1.72, 

1  1.62,1.53,1. 44/ 

DATA  ALPHAL/.566.  .428,  .364,  .293,  .217,  .210,  .220,  .206, 

1  .  192 ,  .  165 ,  .  134 ,  .114,  .104/ 

DATA  DEGRAD/U . 0 1 7453293/ 

C 

SECTH  =  1 . 0/ COS( DEGRA0«THETPS) 

DO  lOU  1=1, NWAVEL 

100  P!l)  =  P( I ) »SOLARC ( I ) ‘EXP! - ALPHAL! 1 ) »SECTH) 

C 

RETURN 

END 
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SUBROUTINE  CHRMXV  (  P  ,  A  .  ,  .OOMW'jl  .  PURI  T  v  ) 

ON  NMM6/CHRMXy 

GIVEN  A  SET  OF  RADIANCES  OR  IRRAOIANCES,  P,  AT  THE  NHM  WAVELENGTHS, 
THIS  routine  COMPUTES  THE  CHROMATICITV  COORDINATES  (X.V)  FOR 
plotting  ON  A  CHROMATICITV  DIAGRAM.  THE  CORRESPONDING  DOMINANT 
wavelength  and  PURITV  are  also  COMPUTED.  SEE  APPENDIX  C  OF  THIS 
REPORT  FOR  DETAILS. 

PARAMETER  (NWAVEl=13.  MXPURE=37) 

DIMENSION  P( NWAvEL )  , XBAR ( NwAvEL )  . VBAR (NWAVEl )  , ZBAR  C  NWAVEL ) 

DIMENSION  WAVEL(MXPUREI . XPURE (MxPURE ) . V PuR E ( MXPuR E ) , SlOPUR (MXPURE ) 

THE  13  TRISTIMULUS  FUNCTION  VALUES 

DATA  XBAR/ .0143,  .2148,  . 3362 ..1421.. 0049 .  .  1096 ,  . 4334  ,  .  0425  , 

1  1 . 0622,  .  7514 ,. 2835 .  ,0636.  .0114/ 

DATA  YBAR/ . 0004 , . 0073 , . 0380 ..1126, .3230. .7932,. 9950 , .9154, 

1  . 63 10 ,  . 32  10 ,  .  1070 ,  . 0232 ,  . 004  1/ 

DATA  ZBAR/ .0679, 1.0391,1.7721.1.0419. .2720, .0573, . 0087 , . 0018 . 

1  ,  0008 .  .0001 ,0  , 0 .  .0 . / 

THE  37  SPECTRUM  lOCUS  VALUES 

DATA  WAVEL/4Q0. .450. ,460. ,470. .475. .480. .485. .490. , 

1495.  ,500.  ,505.  .510.  .515.  .520.  .525.  .530.  .535.  ,540.  .545.  , 

2550.  ,555.  .560.  ,565.  ,5  70.  ,5  75.  .580.  ,585.  ,590.  .595.  .600.  , 

3605  .  ,  610  .  .  620  ,  .  •^  10  .  .  640  .  .  650  .  .  700  .  / 

DATA  XPURE  '  ,  173  1 ,  .  1;.66  .  .  1440  .  .  1  ''4  1  .  .  1096  ..0913,.  0687  . 

1  .  0454  ,  .  0  235  ,  .1082.  .  0039  ,.  01.19  .  .  0389  ..0743,  .1142,  .1547, 

2  .1929,. 2296,. 2  658 ,  . 30  16 .  . 3373 .  . 3 7 3  1  ,  .  408  7  ..4441,  .4788. 

3  .5125 ,. 5448 ,. 5752 .. 6029.  . 6270 ,  . 648  2 ,  .6658 ,  .69  15,  . 7079 , 

4  .  7190,  .  7260,  .  7,j47/ 

DATA  vPURE/  . 0048 .  . C  1  7  7 ,  . 0x9  7  .  . u57b  .  . 0868  ,  .  1327  ,  ,  2007  . 

1  . 2950 .  . 4  127  .  ,  !  84  ,  . 6540 .  . 750 2  .  . 8  1  20 ,  .  8 3 38  ,  . 8 262  ,  . 8059 , 

2  .78  16,  .7543,  .7  243.. 692  3  .  . 6589,  . 6245 ,  .5896,  . 554  7  ,  . 5  20  2 , 

3  .4866.  .4544,.-.  ,'42..  3965  ,  .3  725,  .3514,  .  3340  ,  .  3083  .  .  29  20  . 

4  .28  09,. 2740../' 65  3/ 

DATA  kAll/U/ 

COMPUTE  INTEGRA,  S  BV  SIMPSON'S  RULE,  L.2 

CAPX  /  P(l)*XBARtl)  f  P(NwAvEL)‘XBARiNWAvEL) 

CaPV  -  Pll)*v8***.  ^1)  ♦  PvNv-<AVEL)*VBAR(f4wAvEl) 

CAPZ  -  P(1)*Z8AK(1)  <■  P(NwAv£L  )  *ZBAR(  NWAVEl  > 

DO  100  I -2 . NWAvEl -  1 , 2 

CAPX  =  CAPX  4 , 0*P  (  I  ) ‘XBAR  (  I  ) 

CAPY  =  CAPY  +  4 , 0* P ( I ) ‘ YBAR ( I j 

100  CAPZ  =  CAPZ  +  4 . 0‘P ( I ) ‘ZBAR ( I ) 

DO  IIU  I =3  .  NWA . LL -  2 , 2 

CAPX  ^  CAPX  «  .  , 0‘P ;  I  ) ‘XBAR C I  i 

CAPY  =  CAPY  ^  .•.0*P(l>‘VBARiI) 

110  CAPZ  =  CAPZ  >  ■  . 0*P( I  ) ‘ZBAPi  I  ) 

F  /  6800 . /Fl  Or" , NWAVEL -  1  / 

CAPX  =  F*CAPa 
CAPV  =  F*CAPV 
CAPZ  =  F*CAP/ 

normalize  1hE  integrals  Tl  get  "‘LL  ChRUMATICITY  COORDINATES,  BY  C.3 

X  =  CAPX/(CAP»  ♦  LAP'/  »  CAPZ', 

V  /  CAPV /(  CAP.”  <■  CAPV  »  CAPZ  I 

I F ( K All . EO . 0  1  ■ HtN 

COMPUTE  THE  Sl'PFS  NEEDED  FUR  R  i  NT' ( r,u  The  DOMINANP  WAVELENGTH 
AND  purity 

XW  /  1  . 0/3 . 0 

YW  =  1 . 0/3 , 0 

DO  50  I  =  1,MXPliPE 

50  SlOPURII)  =  (vw  -  VPuREf 1 ) )/(XW  -  XPUWEIIU 
FALL  =  1 

ENDl  F 
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COMPure  the  dominant  wavelength  and  purity  of  the  chromaticitv 
COORDINATES  (X.V) 

DV  =  VW  -  V 
DX  =  XW  -  X 
SLOPE  =  DV/DX 

99  IF(DV.GE.O.  .AND.  DX.GE.O.)  THEN 

SEARCH  lower  LEFT  OF  SPECTRUM  LOCUS.  POINTS  2  TO  9 
DO  200  1=2,9 

IF(SlOPE.LT.SLOPUR(  1)  .ANO.  SLOPE . GE . SLOPUR ( I ) )  GO  TO  250 

200  continue 

ELSEIF(DY . LE . 0 .  .AND.  DX.GE.OJ  THEN 

SEARCH  UPPER  LEFT  OF  SPECTRUM  LOCuS .  POINTS  9-22 
DO  202  1=9.22 

IF(SlOPE.GE.SLOPUR(I) )  GO  TO  250 
202  CONTINUE 

elseif(dv.le.o.  .and.  ox.le.o.)  Then 

SEARCH  UPPER  RIGHT  OF  SPECTRUM  LOCUS.  POINTS  22-33 
DO  204  1=22.33 

1F{ SLOPE .GE. SLOPURC I  )  )  GO  TO  250 
204  CONTINUE 

ELSEIFCDY.GE.O.  .AND.  OX.LE.O.)  IhEN 

SEARCH  lower  right  OF  SPECTURM  LOCUS.  POINTS  33-37 
DO  206  1=33,37 

IF( SLOPE .GE . SL0PUR( I  )  )  GO  TO  250 
206  CONTINUE 

ENOIF 


C 


L 

C 


C 


POINT  IS  IN  PURPLE  REGION,  REVERSE  (X.V)  AND  THE  WHITE  POINT  AND 
SEARCH  AGAIN 
OX  =  -  OX 
OV  =  -  DV 
GO  TO  99 

COMPUTE  INTERSECTION  POINT  OF  CHROMATICITV  LINE  AND  SPECTRUM  LOCUS 

250  XPI  =  XPUREC I ) 

VPI  =  VPUREC  I  ) 

XPIMl  =  XPURE(I-l) 

VPIMl  =  VPURE(I-l) 

51  =  (X  -  XW)/(V  -  VW) 

52  =  (XPI  -  XPIM1)/(VPI  -  VPIMl) 

XI  =  (S2»XW  -  SI*XPIM1  -  S1*S2«(VW  -  VPIM1))/(S2  -  SI) 

VI  =  (XW  -  XPIMl  -  S1*VW  +  S2»YPIM1 ) / ( S2  -  SI) 

GET  DOMINANT  WAVELENGTH  8V  INTERPOLATION 

DT  =  SQRT((XPI  -  XPIM1)*»2  +  (VPI  -  VPIM1)**2) 

01  =  SQRT((XI  -  XPIM1)‘*2  +  (VI  -  yPIMl)»»2) 

F  =  DI/DT 


DOMWVL  =  (1.0  -  F ) »WAVEL( 1  -  1  )  ♦  F»WAVEl(I) 
EQ  =  SaRT((XW  -  X)*»2  ♦  (VW  -  V>‘»2) 

EW  =  SQRT({XW  -  XI)»*2  +  (VW  -  vl)«»2) 

PURITY  =  EQ/EW 

RETURN 

END 
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subroutine  PLTBLUIXPLT.  y'PlT.NPTS.LABPNT,  ITOP,  ITITlE) 

c 

C  ON  NHMB/PlTBLU 

c 

C  THIS  ROUTINE  DRAWS  THE  'BLUE  CORNER'  UF  A  CHROMATICITV  DIAGRAM 

C  AND  PLOTS  POINTS  ON  IT 

C 

C  standard  CALCOMP  PLOTTING  ROUTINES  ARE  USED 

C 

parameter  (MXPURE=9) 

DIMENSION  IWAVEL (MXPURE) , XPuRE ( MXPURE ) .YPURE(MXPURE) 

DIMENSION  XPLT(NPTS).VPLT(nPTS).IT0P(8).ITITLE(8.NPTS) 

C 

DATA  IWAVEL/ 400, 450. 460. 4 70. 475, 480. 485, 490, 494/ 

DATA  XPURE/ .  173  3  .  .  1566 ,  .  1440 ,  .  1241  .  . 1096.  .0913,  .  068  7  ,  . 0454  .  .0  259/ 
DATA  VPURE/ . 0048 . .0177, .0297. .0678, .0868 . . 1327 . . 2007 . . 2950 , .4/ 

C 

DATA  XI NCH , V 1 NCi  i ' 4 . 0 , 4 . 0/ .  HTlC/0.1/ 

DATA  RADEG/57 . 2957795 13/ 

C 

C  INITIALIZE  AND  DRAW  AXES 

C 

CALL  AXIS(0.0,0.0,1HX.-1 .XI NCH.O . 0 . 0 . 0 .0 . 1 ) 
call  AXISIO.O.O.O.IHV,!. Y INCH .90 . 0 .0 . 0 . 0 . 1) 

CALL  PLOT(0. . YINCM,3) 

call  Plot ( XI nch . y inch . 2 ) 
call  PLOT(xInCh.O. , 2) 

NC  -  nChAR ( I  TOP . 8  ) 

IF(NC.NE.O)  then 

Call  Symbol ( 0 . 5* xi nch  -  0 . 5*Floa M NC j »ht IC .  y i nch^ 2 . 0*ht 1 C .  htic. 
1  I  TOP.  0.0,  NO 
ENDIF 

c 

C  DRAW  THE  SPECTRvM  LOCUS 

c 

XSCALE  =  XINCH/0  4 
YSCALE  =  YINCH/0.4 

call  plot ( XSCALc  * XPURE (  I  I  , YSCAlF  » /PURE (  1 )  . 3 ) 

00  100  I=2,MxFuR£-1 

call  PlOT(  XSCAi  F  ‘XPURE  {  I  )  .  YSCAI,  E  •  YPuRE  (  I  )  .  2  ) 

C 

C  ADO  tic:  marks 

SLOPE  =  -  (XPURECI-'I)  -  XP'JRE  (  1  ni/lYPOREII-*!)  -  YPURE  (  I  -  1  )  ) 

THETA  =  RADEG‘A Tan( SLOPE )  -  90. 

CALL  symbol ( XSCALE ‘XPURE ( I )  . YSCAL E * YPURE ( I  )  . HT I C ,  I  3 . ThETA , -  1 ) 

100  CONTINUE 

call  PlOTIXSCA  E ‘XPURE (MXPURE ), ySCAlE ‘YPuRE ( MXPURE ). 2 ) 
call  PlOTiXSCAlF‘0.4.YSCALE*0. 1100.3) 

ca,.l  Plot  (  xsc  c  ‘XPURE  ( i ) ,  yscale*  ycn.re  '  i  i  ,  2 ) 

c 

c  ADO  wavelength  lABElS  TO  SELECTED  ’ I ) S 

C 

on  110  1=1.8 

ENCODE ( 4 ,  120 . BCD)  I WAVEL( I  ) 

lie  call  SvMBUL(X,.ALE‘XPURE(I)-5.0*hML.vGCALc.  ‘YPUREtlJ-Q.B’HTIC. 

1  HTl C , BCD , 0 . 0 , 4 ) 

C 

C  plot  The  WHITE  POINT 

c 

call  S  YMBOl  (  X  SCAi  E  /  3 , 0  .  V  SC  AlE  /  -3  .  u  .  0  . . .  ;i ,  U  .  O  .  -  1  ) 

c 

c  PLOT  chrcmati  :fY  coordinates  i--LT..Pi.  t)  on  The  diagram 

c 

I F ( NPTS  GT . 0 1  THEN 
DO  200  I^l.NPTj 
X  =  xSCALE»*Pc  t(  I  ) 

V  =  VSCAlE'V'-’L  ill) 

call  symbol  I  ■•:  .  y  ,  0 , 5*ht  I  c  .  1  .  O  .  u  ,  1) 

I  F  ( L ABPN  T  . NE  . L  )  Then 
fpn  =  Float ( I) 

call  number  (X‘ii.5‘HTic.Y-ii,5*Hr!L.H!r<.  ,fpn,o.o,-1) 
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X  =  XINCH  +  i.o 

V  =  YINCH  -  FPN»2.0*HTIC 

CALL  NUMBER (X . V .HTI C , FPN , 0 . 0 1 ) 

NS  =  NCHAR( ITI TlE ( 1 . I ) . 8 ) 

CALL  SYMBOL(X+2 .5»HTIC . V .rtTIC. ITITlE(  1  I)  0  0  NS) 
ENDIF  ’  ■  •  ■ 

200  CONTINUE 
ENDIF 

C 

call  PL0T(0.  .0.  .-3) 

RETURN 

C 

120  FORMAT! IH  .13) 

END 


SUBROUTINE  PLTCHR(XPLT , YPlT . NPTS . LABPNT .ITOP.ITITLE) 

ON  NHM6/PLTCHR 

This  routine  draws  a  CHROMATICITV  diagram  and  plots  points  on  IT 
standard  calcomp  plotting  routines  are  used 
parameter  (MXPURE=37) 

DIMENSION  IwAVElI MXPURE  )  , XPURE ( MXPURE )  . VPUREI MXPURE ) 

DIMENSION  XPLT(NPTS) , VPLT<NPTS) . IT0P(8) . I TI TlE I  8 . NPTS ) 

C 

DATA  IWAVEL/400 . 450 . 460 , 470 .475,480 . 485 . 490 , 
1495,500,505,510.515.520.525,530.535.540.545. 
2550.555.560,565.570,575,580.585,590.595.600. 

3605 ,610.620. 630 . 640 . 650 .700/ 

DATA  XPURE/ .  17  33  .  .  1566  ,  .  1440 .  .  1 24  1  .  . 1096,  .0913,  . 068  7 . 

1  . 0454 0235 0082 0039 0139,  . 0389 ,.0743,  .1142,  ,1547. 

2  .  1929 ,. 2296 .  . 2  658 ..3016,  .3373.  .3731.. 4087 ,  .4441.  .  4788  . 

3  .5125.. 5448  .  . 5 7 5 2 ,  . 60 29 ,  . 6270  .  . 6482.  . 6658 ..6915,  .7079, 

4  . 7  190  .  . 7260 .  . 7347  / 

DATA  YPURE/ .0046,  .0177,  .029  7.  .05  78.. 0868 .  .  1327  .  . 200  7 , 

1  .  2950 ,.4127,  .5384,  .6548,. 7502,  .8120.  .  8338  .  .8262 .  . 8059  . 

2  .7816,  .7543,  .7  243,  .69  23,  .6589.  .6245,  .5896,  .5547,  .5202. 

3  . 4866 . . 4544 .. 4242 .. 3965 ,. 3725 .. 3514 , , 3340 . . 3083 , . 2920 , 

4  . 2809 . . 2740 , . 2653/ 

C 

DATA  X  I NCH , V  I NCm/ 4 . 0 . 4 . 5/  ,  HTIC/0.1/ 

DATA  RAOEG/57. 295779513/ 

C 

C  INITIALIZE  AND  DRAW  AXES 

C 

CALL  AXIS(0.0,0.0.1HX,-l.XINCH.0.0.O.U.O.2) 

CALL  AXISIO. 0,0.0,  IHV,  1,VINCh.90.0.0.0.0.2) 
call  plot  (  0  .  ,  V  I  r)CM  ,  3  ) 

CALL  Plot (X  I NCH ,  y I NCH , 2) 

CALL  plot ( XI NCm . Q . , 2 ) 

NC  =  nChAR (  I  TOP , 8  J 
IF(NC.NE.O)  Then 

call  SYMBOLIC. 5*xINCH  -  0 . 5 « F LOA T ( NC ) ynT I C ,  Y I NCH^ 2 . 0 *HT I C .  HTIC, 
1  ITOP.O.O.NC) 

ENDIF 

C 
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C  DRAW  the  spectrum  LOCUS 

C 

XSCALE  =  XINCM/0.8 
VSCALE  =  VINCH/0.9 

CALL  Plot  (XSCALE ‘XPURE  '  1  )  ,  V  SC  Al  E  •  v  PuRE  (.  1)  .3) 

DO  100  I=2,MXPURE-l 

CALL  PlOT(XSCAlE»XPuRE ( I )  . Y SC Ac E • vPuRE (  I  )  ,  2  ) 

C 

C  ADD  TIC  MARYS 

SLOPE  -  -  (  XPORE  (  I  •-  I J  -  XPuREl  1  -  1  i  )  /  (  vPuREI  I  1 )  -  ypURE(I-l)) 
theta  =  RADEG*ATAN{ SLOPE )  '  90. 

call  symbol ( XSCAlE*XPURE( I  )  . Y SCALE ‘YPuREC 1)  .HTIC .  13 , THETA . -  1  ) 
lOO  CONTINUE 

call  PlOT(XSCAlE*XPURE (MXPURE ) . VSCAlE*YPURE{MXPURE) . 2 ) 

CALL  Plot (X SC ale *0 . 2463 , VSCAuE«0 . OJB? . 2) 

CALL  PL0T(XSCALE*0. 1845.YSCAlE*0.0100.3) 
call  PLOT(XSCAlE»XPUREI 1) .YSCALe»YPURE(l) .21 

ADD  wavelength  LABELS  TO  SELECTED  TICS 

encode ( 4 ,  120 , BCD  I  IwAVEL(l) 

CALL  SYMBOL (XSC ale »XPURE(  1 )  . Y SC Al E * Y PURE ( 1 ) -  0 . 25*HT 1 C , HT I C , BCD . 

1  20.0.4) 

ENCODE { 4 . 120 . BlD i  IWAVEL(3) 

call  symbol ( XSCAi.£»XPURE  t  3)-4.0»hTIC.  YSCAL6*YPURE13)-2.U»HTIC, 

1  HTIC. BCD .20.0.4) 
encode  (  4  ,  1.''0  .  BCD)  IWAVEH  4  ) 

call  5YMB0L(XSCALE»XPURE(4)-4.U»HTIC.  y SC A L E * V PUR E ( 4 ) - 2 . 0 *HT I C . 

1  HTIC. BCD, 20.0,4) 

ENC0D£(4.  12Q.BCDi  IWAveL(6) 

call  symbol ( XSCAl6»XPURE( 6) -4 . 0»hT IC .  Y SC A lE * Y PUR E ( 6 ) -2 . 0»HT 1 C . 

1  HTIC, BCD, 20.0.4) 

DO  no  1-8,34,  :•> 

ENC0D£(4,  120.9CD  1  IWAVECd) 

1 10  call  SYMBOL! XSC a l£*XPURE( 1 )  , V SC ALE ♦ YPURE ( I)-0.25*HTIC.hTIC,BCD. 

1  20.0.4) 

eNC0DE(4. 120,Bro)  IWAVEL(37) 

call  SYMBOL  (  XS'  •'  l  £»XPURE  (37  )  ,  YS(  AlE'YPuRE  (37)-0.25*hTIC,  HTIC,  BCD, 
1  20.0,4) 

C 

C  Plot  the  white  -oint 

c 

call  SYMBOL  (XsnLE/J.0,YSCALE/3.U.'J.2.3,0.0,-l) 

C 

C  PLOT  ChROMATICITy  coordinates  (xPlT.YPlT)  ON  The  DIAGRAM 

C 

I F ( NPTS . GT , 0 )  "HEN 
DO  200  m.NPl' 

X  -  XSI ALE*XPl  'll) 

Y  -  YSCALE*YPl.'  (  I  ) 

■"  A  I  L  SVVHOi  (  X  ,  -  .  0 . 5*hT  I  C  ,  1  .  0 . 0  .  -  !  ) 

I  F ( lABPNT . NE . C  -  THEN 
FPN  =  F . OAT ( I ) 

call  NUMBER(X'i5»nTic,Y-0.5*Hin.HTl(_.FPN.U.0,-I) 

X  =  X  I  NCH  I  D 

y  =  YINCH  '  FT  '4*2 . 0*HT1C 

call  number  (.<■'  ,HT  K  ,  FPN  .  D  .  0  .  1) 

NS  =  NCMARflli'LECi.II.d) 

call  Symbol  I  X  '  ’ .  ‘j»my i c  .  y  . ht i .  n  i  r  lE i  i .  i  )  . o . o  , ns  ) 

ENDI  L 

200  continue 

ENDl  F 
C 

call  Pi,  0T(  0.  .  ■  .  -  .1) 

RETURN 

C 

1  20  format (  1H  ,  I  J ; 

END 
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C.  Plotting  Data  as  a  Function  of  Wavelength 

If  data  have  been  generated  for  each  of  the  13  wavelengths  described  in  paragraph  B 
above,  it  is  often  desirable  to  plot  the  data  as  a  function  of  wavelength.  Program  MPWAVE 
generates  such  plots. 

1.  Input 

Three  or  four  records  are  read  to  specify  the  details  of  the  plot,  and  the  pairs  of  records 
containing  the  wavelength-dependent  data  are  read. 

Record  1:  ITITLE 

This  is  a  title  for  the  top  of  the  plot.  Up  to  80  alphanumeric  characters  are  allowed. 

Record  2:  LABYAX 

This  is  a  label  for  the  y-axis  (the  ordinate)  of  the  plot.  Up  to  80  characters  are  allowed. 
Record  3:  NTRACE,  ILOG,  lAUTOY,  IPLABL,  lATMOS 


NTRACE 

gives  the  number  of  data  curves  (traces)  to  be  drawn  on  a  given  set  of  axes 
(i.e.  on  the  same  plot).  (Up  to  20  traces  are  allowed  in  the  listed 
code;  see  parameter  MXTRAC  in  program  MPWAVE.) 

ILOG 

=  0 
=  1 

if  the  actual  data  values  are  to  be  plotted 

if  the  logarithm  (base  10)  of  the  data  is  to  be  plotted 

lAUTOY 

=  0 
=  1 

if  Record  3a  specifies  the  y-axis  scaling 

if  the  plot  program  examines  the  data  to  determine  convenient  y-axis 
scaling 

IPLABL 

=  0 
=  1 

if  the  plotted  curves  are  not  numbered  or  labeled 
if  the  plotted  curves  are  to  be  numbered  and  labeled 

I  ATM  OS 

=  0 
=  1 

if  the  raw  data  values,  P(l),  are  to  be  used 

if  the  raw  data  values  are  to  be  transformed  by  the  atmospheric  model 

Record  3a:  YINCH,  YMAX,  YMIN,  IDIV,  NCODE 

This  record  is  read  only  if  lYAUTO  =  0.  If  lYAUTO  =  I,  the  default  values  shown  below 
are  used. 

YINCH  (default  value;  6.0).  The  length  y  of  the  y-axis  in  inches.  The  x-axis  is 
always  6.0  inches  long  and  is  labeled  with  wavelength  values. 

YMAX  (default:  internally  generated).  The  maximum  y  value,  used  to  label  the 
y-axis  and  .scale  the  data 
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YMIN  (default:  internally  generated).  The  minimum  y  value,  used  to  label  the 
y-axis  and  scale  the  data 

IDIV  (default:  5  to  10,  internally  generated).  The  number  of  divisions  in  the 

y-axis  labeling. 

NCODE  (default:  8,  see  record  3b).  The  number  of  characters  to  be  transferred  in  the 
FORTRAN  ENCODE  statement.  See  record  3b. 


Record  3b:  YFMT 

This  record  is  read  only  if  lYAUTO  =  0. 

YFMT  is  an  execution-time  format  used  to  generate  data  values  for  labeling  the  tic 
marks  on  the  y-axis.  It  should  end  with  ",2HA-)",  which  draws  tic 
marks  with  the  in  the  2HA-.  The  "A"  symbol  indicates  a  blank. 
The  default  is 
(F6.2,  2HA-) 

This  generates  tic  mark  labels  of  the  form 
123.45  -I 

I  <— y-axis  vertical  line 

where  the  from  the  "2HA-"  in  the  format  is  the  plotted  tic  mark. 
The  default  value  of  NCODE  =  8  is  the  total  of  6  (from  the  F6.2)  plus 
2  (from  the  2HA-). 

The  format 
(F3.0,  2HA-) 

would  generate  tic  mark  labels  of  the  form 
12.  - 

Now,  NCODE  =  5 


Record  4:  LABTRC 

This  is  a  label  for  the  plotted  trace.  Up  to  80  alphanumeric  characters  are  allowed. 


Record  5:  THETPS,  P{1),  P(2),  -,P(  13) 

This  record  has  the  same  form  as  record  4  of  Program  MPCHRO:  THETPS  is  the  solar 
zenith  angle  and  P(l),  I  =  1,  •  J  3  is  the  data  value  for  wavelength  I, 


Records  6  and  7,  8  and  9,  ■ 

Pairs  of  records  of  the  same  form  as  4  and  5  are  repeated  for  each  trace  to  be  plotted.  Up  to 
20  traces  are  allowed  on  the  same  plot. 
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2.  Code  Listing 


c 

c 

c 

c 

c 

c 

c 

c 

c 


c 

c 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


( 

( 

( 

(, 


PROGRAM  MPWAVEC INPUT , OU TPUT . T APE5= 1 NPUT . TAPE6=0UTPUT , TAPE98 . 

1  TAPE99) 

ON  NHM6/MPWAVE 

THIS  PROGRAM  PLOTS  DATA  AS  A  FUNCTION  OF  WAVELENGTH. 

all  plotting  is  DONE  USING  STANDARD  CAlCOMP  CALLS 
(TAPE90  AND  TAPE&9  ARE  USED  BV  THE  CALCOMP  ROUTINES.  AS 
implemented  on  the  AUTHOR'S  COC  CVBER  856  COMPUTER.) 

PARAMETER (MXWAVE^ 13 ,  MXTRAC=20) 

PARAMETER  (MXPLT  =  MXW  A  VE->- 2  ) 

DIMENSION  DATA (MX WAVE, MX TRAC). LA6TRC{8 .MXTRAC) 

DIMENSION  LABVAX(8) , ITITLE(8) 

COMMON/ CSC AlE/  VINCH.YMAX.YMIN. ID! V .NCODE . YFMT ( 2 ) 

COMMON /CWORK/  X(MXPlT) .Y{MXPLT) , TRACE (MXPLT , MXTRAC) 

DATA  NWAVEl/13/ 

CALL  Plots 

call  PL0T( 2 . 0 . 2  U . -3) 

READ  the  title  FOR  THE  TOP  OF  THE  PLOT 
990  READC5  ,  100 , ENO=  1000)  ITITlE 

title  for  The  v  axis 

R£AD(5 , 100)  LABVAX 
READ  PLOT  SPECIFIERS 

ntrace  =  The  number  of  traces  (curves)  to  be  drawn 
IlOG  =  1,  IF  L0G(BASE  10)  OF  The  DATA  IS  TO  BE  PLOTTED 
0,  IF  actual  DATA  VALUES  ARE  TO  BE  PLOTTED 
IAuTOV  =  1.  if  the  PLOT  PROGRAM  EXAMINES  THE  DATA  TO  DETERMINE 
CONVENIENT  Y  AXIS  (ORDINATE)  SCALING 
IPlABL  =  1,  IF  Tm£  PLOTTED  CURVES  ARE  TO  BE  NUMBERED  AND  LABELLED 

0,  IF  THE  CURVES  ARE  NOT  NUMBERED  AND  LABELLED 
lATMOS  =  1.  IF  The  RAW  DATA  VALUES  ARE  TO  BE  SCALED  BY  THE 

WAVELENGTH-SOLAR  ANGLE  DEPENDENT  ATMOSPHERIC  MODEL 
0,  IF  The  raw  DATA  ARE  NOT  SCALED 

REA0(5, * )  NIRfluE, ILOG, IAUTOY. IPlABL . lATMUS 

READ  the  specifications  FOR  SCAlINu  The  Y  (VERTICAL)  AXIS.  IF  DESIRED 
YINCM,..TH£  length  of  The  V  AXli.  IN  INCHES 

YMAX,  YMIN,..ThE  maximum  AND  MINIMUM  Y  VALUES  TO  BE  USED  FOR 

The  y  axis  labels 

IDIv...ThE  number  of  divisions  of  The  Y  axis,  for  labelling  TIC  MARKS 
NCOOE...THE  NUMBER  OF  CHARACTERS  IN  ThE  TOTAL  WIDTH  OF  THE  Y-AXIS 
TIC  MAR.'-  labels  (USED  IN  ENL.ODE  STATEMENTS).  E.G.  IF  THE 
NEXT  DATA  RECORD  HAS  ( F G . 2 . 2H  )  AS  THE  FORMAT,  THEN 
NCODE  =  O  <•  2  =  6 

YFMT... A  FORMA'  FOR  LABELLING  THE  v  AXIS  TICS.  IT  SHOULD  END 

with  ,  2h  )  WHICH  DRAWS  The  TIu  MARi<,S  with  THE  MINUS  SIGN 
I F ( IAUTOV . EQ . 0 )  THEN 

REAU  I  5  ,  ♦  )  V  I  N(  H  .  VMAX  .  YMI  N  .  I  01  V  .  NC.ODE 
R  E  A  D  (  5  ,  1 0  0  )  Y  F  M  T 
ENDI  F 

READ  THE  TRACE  ^ABEi-S  AND  THE  DA '  A  TO  BE  PLOTTED.  ON  STANDARD 
WAVELENGTH  FORMAT 

DO  ZOO  N  TR  =  1  .  NT  R  A  v.  E 

READ(5,  100)  (LABTRC(I  .NTRJ  .I  =  l.Bl 
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READ(5 . • )  ThETPS , ( DATA ( I . NTR ) , I = 1 . NWAVEL) 

C 

I F ( I  ATMOS . NE . 0 )  then 

C  SlAlE  the  raw  data  ACCCRDINO  TO  '^HE  ATMOSPHERIC  MODEL 

CALu  ATMOS (ThETPS , data (  1  ,NTR J ) 

ENDl  F 
C 

200  CONriNOE 
L 

c  Plot  the  data 

c 

call  PLTWVLC  data . NTR ace . I  LOG .  I AUTOV . L ABTRC ,  I PLABL , LAB VAX . I TI TLE) 
CALL  PL0T(  18. 0,0. 0,-3) 

GO  TO  998 

C 

1000  CALL  PLOT (  j .  , 0 .  . -98  ) 

WRITEC6.991J 

C 

C 

100  F0RMAT(8A10) 

999  F0RMAT(1H  wavelength  PLOTS  COMPLETED) 

END 


(. 

C 

C 

C 

c 

r' 

c 

c 

c 

c 

c 

V- 

c 

c 

c 

c 

c 

c 

c 

t 

c 

c 

c 

c 

c 

c 


S.jBRKjTInE  R-  Fw  VL  I  da  T  a  ,  nTpacE  .  1  I  C-'o  .  1  Ah  U)/  l  abt  RC  IPLABL  1  abyax 
1  I  T  n  l£ )  ■  ' 

On  nhmb/Pltwvl 

This  ROu'^ine  p.c.is  data  as  a  functiu'N  of  the  13  nhm  wavelengths. 

tme  :np.)T  !s 


DA  T  13  ,  N’-RA.  E  ,  ,  ,  -Mt  aR^A.  :.f  data  .AljFa  TO  BE  PLOTTED.  EACH 

COLUMN  HGi DS  ONE  Function  of  wavelength,  to  be 

PLOTTED  AS  'NE  ThaCE  uN  THE  GRAPH. 

iLCC.  .--  0,  :f  'riL  ACTuA  data  /aljES  ARE  T(j  BE  •'LOTTED 
-  1.  IF  LOGvBASE  10)  OF  THE  DAIA  Ij  10  BE  PLOTTED 

IA.,TGV...-  0,  IF  THE  y  (VERTICAL)  SLAiING  IS  PREDETERMINED  IN 
hl  MAI.N  .•RjT,RA(V  iCOWMln  UlOCf  CSLAlE) 

-  1.  IF  TmE  data  values  ShOllG  be  EXAMINED  Trj  DETERMINE 

'  •■i'W'jPA  !  A  -  E  V  S-'.  AlK.j  jA_  ;ES 

L  Ab  T  PC  (  I  ,  N  T  R  A  C  E  I  ,  .  .  L  A  BEL  S  USED  TO  IDEl-iTIFV  THE  TRACES,  UP  TO  80 
Characters  each,  tme  labei.s  are  plotted  if 
I  P.- ABl  .  (iC  ,  u 

LABVAXISJ  ..A  lABl.  '  L/R  The  vERTIi.Al  (.DATA)  AXIS,  UP  TO  80  CHAR 
I  T  I  E  ( e  J  .  .  .  A  TI'.E  FOR  The  tup  (jF  TiiE  R'lOT,  UP  TO  80  CHAR 
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^  PARAMETERCMXWAvE- 13  ,  MXPLT=:MXWA\/E»2.  MXTRAC  =  20) 

DIMENSION  DATA(MXWAVE.NTRACE) .  LA0TRC ( 8 . NTRACE ) . LABVAX ( 8 ) 
DIMENSION  ITITLEle) .FMT(2) 

COMMON /C SCALE/  VI nCH , VMAX . VMIN , IDI V , NCOOE , VFMT( 2 ) 

^  COMMON/ CWORX /  XPL T ( MXPL T ), VPL T { MXPl T ). TRACE ( MXPLT , MXTRAC ) 

DATA  JSYMB/1/,  LSVMB/1/,  NWAVEL/13/ 

DATA  XINCH/6. / , VINCH/6. / .H/O  15/ 

DATA  FMT/ 10H(F6. 2 . 2H  -.lOM)  / 

C 

c  select  actual  or  log  values 
c 

IF(ILOG.EQ.O)  then 
DO  100  J=l. NTRACE 
DO  100  I=1.NWAVEL 
100  TRACE! I . J)  =  DATA! 1 . J) 

C 

ELSEIF! ILOG. EO. 1 )  THEN 
DO  102  J=l, NTRACE 
DO  102  I=1,NWAVEL 
102  TRACE!1,J)  =  ALOG10!DATA! I , J) ) 

IF!IAUT0V.£Q.0)  THEN 
VMAX  =  ALOGIO(YMAX) 

YMIN  =  AL0G10!YMIN) 

ENDIF 
ENOI  F 

SET  UP  Y-AXIS  scaling 

IF! iautoy.eo.o)  then 

USE  predetermined  SCALING  VALUES 

OINCH  i  YINCH/FlOAT! IDIV) 

DlABL  =  I YMAX  -  YMIN) /FLOAT! IDIV) 

FLABLO  =  YMAX 
YZERO  =  YMIN 

YPINCH  =  !YMAX  -  YMIN)/YINCH 
EuSE 

C  EXAMINE  the  values  TO  BE  PLOTTED  TO  DETERMINE  THE  VERTICAL  SCALING 

C 

YMIN  =  1.0E200 

YMAX  =  -1.0E200 

DO  110  J=l, NTRACE 

DO  110  I=1,NWAVEL 

YMIN  =  AMI N1 ! YMIN . TRACE!  I  .  J  )  ) 

110  YMAX  =  AMAXl!YMAX,TRACE! I  . J)  ) 

L 

MINV  =  IFIXIYMIN) 

IF ( YMIN . LT . 0  .  )  MINV  =  MINV  -  1 

MAXV  =  IFIX!VMAX) 

I F ! YMAX . GT . 0 )  MAXV  =  MAXV  »  1 

MRANGE  =  MINV  -  MAXV 
IDIV  =  IABS!MRANGE) 

302  IFI5.LE.IDIV  .AND.  IDIV. LE. 10)  GO  TO  300 
I F ! IDI V . GT . 10 )  GO  TO  301 

IDIV  =  IDlV*2 
GO  TO  302 

30  1  IDIV  =  ! IDIV  ♦  1  ) /2 

GO  TO  302 

300  DLABL  =  FLOAT ! I A8S!MRANGE )) /FLOAT ! IDI V J 
I F ! DLABL . LE . 1 . )  GO  TO  303 

I F ! FLOAT ! I F IX!DLABL ) ) . EQ . DLABL )  GO  TO  303 
MRANGE  =  IDIV»IFIX!DLA0L  1.) 

GO  TO  300 

303  DINCH  =  YINCH/FLOAT! IDIV) 

FLABLO  =  FlOAT!MAXV) 

YZERO  =  FL0AT!MINV) 

YPINCH  =  FlOAT!MAXV  -  MINV)/YIN(.H 

NCODE  =  8 

YFMT(  1 )  =  FMT!  1  ) 

YFMT!2)  =  FMT!2) 

ENDIF 
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DRAW  BORDER  AND  LABEL  V  AXIS 


CAl L  Plot ( 0 . , 0 . , 3 ) 
call  PL  Ot  (  0  .  V  [  2) 

call  Plot ( X I  nch .  V I nCi-! ,  2 ) 
call  PLOT(XInCm,0.  . 2)  ’ 
call  plot ( 0 , , 0 . , 2 ) 


XX  =  -( Float (ncode)  -  .4)*m 

DO  310  1  =  1,IDIV»-1 

VV  =  YINCM  -  0.45*M  -  F^OATt  I  -  1  )  .DINLH 

flabl  =  flablO  -  float ( I  - 1 ) *dlabl 
ENCODE C NCODE . VFMT , BCD)  FlaBl 
310  CALL  SYMBOL {XX , VV , M . BCD . 0  0  NC  )DE } 

XX  =  -1,2 

NC  =  NCMAR ( LABYAX . 8 ) 

YY  =  G.5»YINCh  -  0 . B»FlOAT (NC ) ‘n 
^  CALL  SYMBOL ( XX , YY ,H , LABYAX . 90 . 0 . NC ) 

C  DRAW  horizontal  AXIS 


C 

C 

C 


c 

c 


120 


Y1  -  -0.45*M 
Y2  =  -2.35»M 
CO  120  I-I.N.mA.l:, 

XX  -  XINCH*FLOATi;-l)/i-_i_)aT(>jAi^i...|. 
call  SYMBOL ( XX  . Y  I  ,m ,  J 3 . c  .-1) 

I F ( mod  11.2). NE . 0  I  Then 
lambda  =  4U0  +  2s*!,r-n 
ENCODEO,  122,8COl  ^AMBDA 
CA  Li.  SYMBOi.  I  xX  -  1 . 5*h  .  v2  ,  r  ,  BCD  ,  u  .  :■  i 

ENDI  F 
CONT I nuE 

call  Symbol  (  l)  ,  5»XInCh  -  f;.G*h,-4  IdhwAvElENOIH  in  nm.o. 


DRAW  title  at  top 


NC  -  NChAR { 1 T I TlE , 8 ) 

XX  =  G.5*xINCh  -  0 . 5*Fl0AT( nC  ) ‘H 

Yy  -  Y I MH  '  2.0*H 

LAlL  symbol  (  X  X  ,  /  V  ,  H  ,  I  T1  ’•lE  .  C  .  ,  Nl  j 
Plot  the  traces 


C  set  up  the  X  coordinates,  with  scaling,  factors 

DO  200  I^l.NWAVE.. 

200  XPuTCi)  =  4ri0.0  X-  2B  .  0*A^uA  r  (  I  -  1  , 

XPlT ( NwAVEL M  )  -  400.0 
XP^T  (  nWA  YEL-X  2  J  =  SO. 

c 

C  btT  UP  V  LOUPL/NA1E.S  ANix  Pl.U' 

C 

YPi. '!<,  NwAvEL-^1)  =  vZcPu 

V  P  ,,  T  N  rt  A  V  £  L  +  2  ;  -  v  p  j  r, 

ivO  2  llJ  j  ~  1  .  t 

DO  212  i“l,N'v\A7EL 
212  VPlKIj  -  TPACtll.Ji 

call  l  I  N  L  I  X  P  V.  T  .  2  P  ’  .  fj.vA  .  E 1.  .  1  .  V  1,  y  r.’e.  ,  i. 1  tvl3  I 
r 

C  NuMBtP  ^n£ 

V  V  -  I  X  l  T  t  N  VV  A  V  £  )  -  Y  P  -  T  (  rj  //  A  V  E  .  ♦  1  )  I  /  -f  p  i  *  ■  ' ,  A  A  .  •  {j  *  H 

L  N  V  L  L  (  L  .  2  1  A  .  [3  -  .  J 

<;  A..U  SYMBOL  I  X  I  *V.  -  •  :  .  .  V  V  _  FH  _  q;  r.  .  ,  1.1  /  ) 

(.  Pc.'.;T  r'  ,L  ..  I  7  1  ^  (tE  i  Pr  0 

IF(  IPlASl.EO.O;  go  T  u  2  10 
F-  hN  ^  F  lOA  f  (  J  } 

Yx  -  xiNTM  + 

y  y  -  V  I  ncm  -  F  PN* 

Al  .  NUMBER  1  X  .  yy  .  M  .  F  PN  ,  G  .  ij  .  :  , 

fK.  -  nCmaR  (  ;„AB1  RC  f  1  .  J  )  .  6  , 

L  Al  „  ..yMBOl  (  X  2 . .  Y  V  ,  ■  AH  ^  L  .  .  :  ,  J  fu.  J 

210  CGntznl/E 


.  16) 
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RETURN 

122  F0RMAT(I3) 
214  F0RMAT(I2) 
END 
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APPENDIX  A.  IMSL  Routines  Used  by  the  NHM 

The  following  IMSL  subroutines  are  used  by  the  NHM. 


IMSL 

routine 

where  called, 
program/subroutine 

description  of  IMSL  routine 

DCADRE 

4/Y2ZGEO 

numerically  integrates  a  function  of  one 
variable 

DVERK 

4/RICATI 

solves  systems  of  ordinary  differential  equa¬ 
tions  using  a  high-order  Runge-Kutta  scheme 

EIGRF 

4/EIGENR 

finds  eigenvalues  and  eigenvectors  of  a  real¬ 
valued  matrix 

GGNML 

1/INISHL 

generates  pseudo-random  numbers  from  a 
Gaussian  distribution 

GGUBFS 

1/MAIN 

generates  pseudo-random  numbers  from  a 
uniform  distribution 

LINVIF 

4/AMPINT 

inverts  a  matrix 

LINV2F 

4/EIGENR 

inverts  a  matrix  (high-accuracy  version) 

VMULFF 

4/EIGENR 

multiplies  two  matrices 

VSRTA 

4/EIGENR 

sorts  an  array  by  algebraic  value 

VSRTR 

1/TIP 

sorts  an  array  by  algebraic  value  and  returns 
the  permutations 

APPENDIX  B.  A  Simple  Model  for  Incident  Radiance  Distributions 

For  some  purposes,  the  input  radiance  distribution  on  the  water  surface  can  be  ap¬ 
proximated  by  a  continuous  sky  radiance  distribution  plus  a  point  sun. 

For  the  continuous  sky  distribution  we  use  acardioidal  radiance  distribution  given  by 
N(e,<))  =  No(l  +Ccos0) 
or 

N(p,(t))  =  No(l -HCp)  (B.l) 

where  Nq  and  C  are  constants  to  be  chosen.  Note  that  this  sky  radiance  distribution  is  independ¬ 
ent  of  azimuthal  angle  (j)  or  wavelength  X.  The  form  (B.l)  yields  the  quad-averaged  radiances 

N(u,v)  =  No(l (B.l) 
where,  as  always,  is  the  average  p-value  of  quad 

The  scalar  irradiance  h(sky)  of  the  radiance  distribution  (2)  is  given  by  75/8.4: 
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m-1  2n 

h(sky)  =  X  X  N(u,v)  Quv  +  N(m,  ) 
u=l  v=l 
m-1  2n 


=  X  X  No(l+CHu)A^t„^^^  +  No(l+C^l„,)  2icA^„ 


m 


=  27tNo  X  ( 1  +  Cjiu)  Ajiu 

u=l 


=  2tcNo 


m 

X  Ajiu  +C 

L  u=l 


m  n 

X  PuA^lu 

U=1  J 


1 

2 


=  27CNo  1  +  y 


(B.3) 


For  a  uniform  sky,  C  =  0,  and  we  get  h(sky)  =  2jcNq,  as  expected. 

The  plane  irradiance  H(sky)  is  given  by  75/8.7,  which  reduces  to 

H(sky)  =27tNo^2  (B.4) 

m 

after  using  X  Itu  Apu  =  For  a  uniform  sky,  C  =  0,  we  get  H(sky)  =  kNq,  as  expected. 
u=l 

The  well-known  cardioidal  radiance  distribution,  which  approximates  a  heavy  overcast 
with  no  discernible  sun,  corresponds  to  C  =  2. 

Subroutine  QASKY  uses  (B.2)  as  background  for  a  point  sun.  Using  this  model,  we  can 
study  the  effects  of  going  from  all  direct  beam  (the  sun  in  a  black  sky)  to  all  diffuse  light  (heavy 
overcast),  while  keeping  the  total  scalar  irradiance  constant. 

Let  h(sun)  +  h(sky)  s  h(total),  and  define  the  ratio  of  sky  scalar  irradiance  to  total  scalar 
irradiance  as 


^  h(sky)  ^  h(sky) 
h(sun)  +  h(sky)  h(total) 

Using  (B.3)  and  (B.5)  and  solving  for  Nq  gives 


(B.5) 
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No  = 


R  •  h(total) 


and  h(sun)  =  h(total)(l-R). 

Subroutine  QASKY  computes  the  quad-averaged  input  radiances  by 


N(u,v) 


R(l+C|iu) 

2t(^l  ^  §  j 


h(total) 


(B.6) 


(B.7) 


for  "sky  only"  quads,  and 


N(u,v)  = 

f-R(l+Cpu)  1-R-| 

h(total) 

L  V  y  J 

(B.8) 


for  the  "sky  +  sun"  quad.  Note  that  for  R  =  1  (no  sun)  and  C  =  0  (uniform  sky),  each  quad  gets  a 
quad-averaged  radiance  of  magnitude  N(u,v)  =  h(total)/2;t. 

APPENDIX  C.  Computation  of  Chromaticity  Coordinates 

The  standard  way  of  displaying  water  color  is  the  chromaticity  diagram*.  The 
chromaticity  coordinates  X,  Y,  Z  are  given  by 
700 

X  =  680  J  P(X)x(>.)d^  (C.l) 

400 

with  corresponding  equations  for  Y  and  Z.  Here  X  is  wavelength  in  nanometers,  P(X)  is  a 
radiance  or  irradiance,  and  \{X)  is  the  tristimulus  (color  matching)  function  for  red. 

This  integral  can  be  approximated  by  Simpson’s  rule  if  the  400-700  nm  interval  is  divided 
into  an  even  number  of  subintervals.  For  runs  with  the  NHM  we  choose  12  subintervals  of  width 
AX  =  25nm,  and  run  the  monochromatic  NHM  at  the  13  wavelengths  of  Xj=4(X)nm, 
X2  -  425  nm,-  -,>,j3  =  700  nm.  Then  X  is  computed  by 

X  =  680  ^[P(400)  x(400)  +  4P(425)  x(425)  +  2P(450)  x(450)  + 

•  •  •  2P(650)  x(650)  4P(675)  x(675)  +  P(700)  x(700)]  (C.2) 


*  See,  for  example,  Hydrologic  Optics,  Vol.  I,  Introduction,  by  R.W.  Preisendorfer,  Pacific  Marine 
Environmental  Laboraiory/NOAA,  Honolulu,  HI,  pages  142-151.  Available  from  NTIS  as  document 
no.  PB-259793/8ST. 


166 


APPENDICES 


The  normalized  chromaticity  coordinates  are  given  by 

_  X  _  Y  _  Z 

’‘“X+Y+Z  ’  ^“X+Y+Z  ’  ^“X+Y+Z- 

The  (x,y)  normalized  coordinates  can  be  used  to  plot  a  point  on  a  1931  C.I.E.  chromaticity 
diagram. 

The  table  below  gives  the  values  of  x(X),  y(A,),  z(X)  for  the  13  X,-vaIues  used  in  the  NHM. 


Tristimulus  (color  matching)  functions  x,  y  and  z* 


_  _  weight  for  Simpson’s 

X  x(^)  y(X)  z{X)  rule  integrations 


400 

.0143 

1 

425 

.2148 

4 

450 

.3362 

1.7721 

2 

475 

.1421 

.1126 

1.0419 

4 

500 

.0049 

.3230 

.2720 

2 

525 

.1096 

.7932 

.0573 

4 

550 

.4334 

.99d0 

.0087 

2 

575 

.8425 

.9154 

.0018 

4 

600 

1.0622 

.6310 

.0008 

2 

625 

.7514 

.3210 

.0001 

4 

650 

.2835 

.1070 

0 

2 

675 

.0636 

.0232 

0 

4 

700 

.0114 

.0041 

0 

1 

sums 

4.2699 

4.2712 

4.2617 

Integrals 
for  P(X)  =  1 

72319. 

73005. 

72170. 

700 

Note  that  the  integrals  680  J  x(A,)dA.  =  72319  ,  etc.,  agree  to  within  1%,  which  is  the  same 

400 

order  of  accuracy  as  the  output  of  the  NHM. 

Converting  (x,y)  into  (dominant  wavelength,  purity) 

Subroutine  CHRMXY  draws  the  spectrum  locus  of  the  chromaticity  diagram  by  connect¬ 
ing  37  tabulated  pure-color  coordinates  [Xp(I),  yp(I)],  I  =  I,  -, 37  to  make  a  closed  curve.  The 


*  Taken  from  Color  Science  (2nd  edition)  by  G.  Wyszecki  and  W.  Stiles,  John  Wyley  &  Sons,  New 
York,  1982,  Table  II  (3.31),  pages  736-7. 
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computed  (x,y)  point  is  then  plotted  on  this  diagram.  For  the  plotted  point  (x,y)  we  can  compute 
a  dominant  wavelength  (or  dominant  color),  X,  and  a  purity,  p.  For  a  point  (x,y)  on  the  diagram 
drawn  by  CHRMXY  this  is  a  simple  exercise  in  analytic  geometry,  and  proceeds  as  follows. 

1)  First  compute  the  slope  of  the  line  between  the  white  point  (x^,  y^)  and  each  of  the  37 
plotted  spectrum  locus  points  [Xp(I),  yp(I)],  I  =  l,  -,37. 

2)  Then  compute  the  slope  of  the  line  between  the  white  point  (x^,  y  )  and  the  plotted  point 
(x,y). 

3)  Then  search  through  the  set  of  "spectrum  locus  slopes"  from  1)  until  the  slope  from  2)  is 
located  between  the  and  (I+D^'spectrum  locus  slopes.  We  now  know  that  the  dominant 
wavelength  X  will  be  somewhere  between  Xj  and  Xj^j,  where  Xj  is  the  wavelength  of  the  I* 
plotted  spectrum  locus  point. 

Since  different  pairs  of  points  (Xj,  yj),  (x^,  y^)  and  (xj,  y2),  (x^,  y^)  can  have  the  same 
slope,  it  is  necessary  to  note  if  x  <  x^  or  x  >  x^  and  if  y  <  y^  or  y  >  y^.  The  slopes  in  the 
corresponding  quadrant  of  the  chromaticity  diagram  (lower  left,  etc.)  can  then  be  searched. 

4)  Compute  the  intersection  point  (Xj,  y^)  between  the  line  connecting  the  I*  and  (I+l)®‘ 
spectrum  lows  points  and  the  line  determined  by  the  white  point  and  the  plotted  point.  The 
point  (Xj,  y-)  is  computed  from  the  solution  of 

the  line  determined  by  (x,y)  and  (x^,  y^) 


the  line  determined  by 

(Xp(I),  yp(I)]  and[Xp(I+l),yp(I+l)] 


r  Xi  -  Xw  X  -  Xm 


yi  -  Vw  y  -  yw 


=  Si 


V 


X,  -  Xp(I-l)  _  Xp(l)  -  Xp(I-l)  _  _ 

yi  -yp(i-i)  ■  yp(i)  -ypd-D 


which  gives 


Xi  = 


S2  Xw  -Si  Xp(I-l)  -Si  S2[yw  -yp(I-l)) 
S2  -  Si 


yi  = 


Xp(I-l)  -  Si  yw  +  S2  yp(I-l) 
S2  -  Si 


(C.4) 


5)  Given  the  intersection  point  (Xp  yX  compute  the  distance  dj  from  [x  (I),  yp(l)]  to  (x-,  y^) 
and  the  distance  d2  from  (Xp  y^)  to  [Xp(I+l),  yp(l+l)J.  Then  the  dominant  wavelength  is 


6) 


Compute  the  distance  d3  from  (x,y)  to  (x^,  y^)  and  the  distance  d4  from  (Xp  y^)  to  (x^,  y^). 
Then  the  purity  is 
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APPENDIX  D.  A  Simple  Model  Atmosphere  and  Solar  Spectrum 

The  input  required  by  the  NHM  is  the  incident  radiance  at  sea  level.  If  the  NHM  is  being 
used  at  only  one  wavelength,  then  the  input  spectral  scalar  irradiance  can  be  set  to  some  conven- 
lent  value,  say  1.0  W  m  nm  \  However,  if  runs  are  being  made  at  various  wavelengths  and  the 
results  are  being  combined,  e.g.  to  compute  colors,  then  the  radiance  on  the  water  surface  should 
account  for  atmospheric  effects  and  for  the  wavelength  dependence  of  the  solar  spectrum.  It  is 
usually  most  convenient  to  make  all  NHM  runs  with  the  same  input,  and  then  to  correct  the 
output  when  computing  colors,  etc.  This  is  allowed  by  the  linearity  of  the  radiative  transfer 
equation. 

Subroutine  ATMOS  uses  a  cmde  model  atmosphere  which  depends  only  on  the  solar 
zenith  angle,  0^,  to  incorporate  atmospheric  path  length  effects  on  the  sun’s  direct  beam.  This 
routine  also  uses  tabulated  solar  spectrum  values  to  incorporate  the  wavelength  dependence  of 
the  solar  spectrum.  The  model  is  based  on  tabulated  values  of  the  scalar  irradiance  at  sea  level* 
for  atmospheric  conditions  of 

pressure  =  760  mm  Hg 

2.0  cm  of  precipitable  water  vapor  per  unit  of  optical  air  mass 

300  dust  particles  per  cm^  in  the  air 

0.28  cm  of  ozone  per  unit  of  optical  air  mass 

The  optical  air  mass  is  1  when  0^,  =  0’  (the  sun  is  at  the  zenith);  it  is  2  =  sec  60’  when  0^  =  60*, 
and  so  on.  The  scalar  irradiance  at  sea  level,  h^^C^,  0^),  is  given  by 

hsL(X,0s)  =h3(>.)e-""'®^®'  (D.l) 

where  h^(^)  is  the  solar  scalar  irradiance  at  wavelength  X,  outside  the  atmosphere,  and  in¬ 
cludes  all  scattering  and  absorption  effects  of  the  model  atmosphere.  The  table  below  gives  the 
values  of  hj(?i)^  and 


*  Taken  from  the  Handbook  of  Geophysics  and  Space  Environments,  ed.  by  S.L.  Valley,  Air  Force 
Cambridge  Research  Lab,  1965,  page  16-19. 

^  These  values  are  taken  from  Hydrologic  Optics,  Vol.  /.  page  23.  The  associated  solar  constant  is 
1396  W  m'^,  which  is  somewhat  too  large. 

■  From  the  Handbook  of  Geophysics  and  Space  Environments.  The  associated  solar  constant  is 
1322  W  m'^,  which  is  somewhat  too  low.  The  are  rcscaled  to  be  consistent  with  1396  W  m'^. 
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X 

nm 

h,(X) 

W  nm  ' 

«X 

400 

1.54 

.566 

425 

1.89 

.428 

450 

2.20 

.364 

475 

2.20 

.293 

500 

1.98 

.217 

525 

1.92 

.210 

550 

1.95 

.220 

575 

1.87 

.206 

600 

1.81 

.192 

625 

1.72 

.165 

650 

1.62 

.134 

675 

1.53 

.114 

700 

1.44 

.104 
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